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

⅄ trunk → 24-06-24-todo-dependents

Browse Source
This commit is contained in:
Mitchell Rosen 2024-06-24 13:42:13 -04:00
commit 3e229d521f
47 changed files with 835 additions and 435 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
.github/workflows/ci.yaml vendored
View File

@ -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:
@ -270,6 +264,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 +419,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

3
.github/workflows/update-transcripts.yaml vendored
View File

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

47
parser-typechecker/src/Unison/Codebase/Path.hs
View File

@ -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,14 +91,19 @@ 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)
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 +115,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)
@ -534,34 +540,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

51
parser-typechecker/src/Unison/PrintError.hs
View File

@ -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
@ -1366,31 +1370,31 @@ renderParseErrors s = \case
<> style ErrorSite (fromString open)
<> ".\n\n"
<> excerpt
L.InvalidWordyId _id ->
L.ReservedWordyId id ->
Pr.lines
[ "This identifier isn't valid syntax: ",
[ "The identifier " <> quoteCode id <> " used here is a reserved keyword: ",
"",
excerpt,
"Here's a few examples of valid syntax: "
<> style Code "abba1', snake_case, Foo.zoink!, 🌻"
Pr.wrap $
"You can avoid this problem either by renaming the identifier or wrapping it in backticks (like "
<> style Code ("`" <> id <> "`")
<> ")."
]
L.ReservedWordyId _id ->
L.InvalidSymbolyId id ->
Pr.lines
[ "The identifier used here isn't allowed to be a reserved keyword: ",
"",
excerpt
]
L.InvalidSymbolyId _id ->
Pr.lines
[ "This infix identifier isn't valid syntax: ",
[ "The infix identifier " <> quoteCode id <> " isn’t valid syntax: ",
"",
excerpt,
"Here's a few valid examples: "
<> style Code "++, Float./, `List.map`"
"Here are a few valid examples: "
<> quoteCode "++"
<> ", "
<> quoteCode "Float./"
<> ", and "
<> quoteCode "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 " <> quoteCode id <> " is reserved by Unison and can't be used as an operator: ",
"",
excerpt
]
@ -1444,11 +1448,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
@ -1458,7 +1463,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
@ -1474,7 +1479,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 ->
@ -1705,7 +1710,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

2
parser-typechecker/src/Unison/Syntax/TermPrinter.hs
View File

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

1
scripts/check.sh
View File

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

4
unison-cli/src/Unison/Cli/MonadUtils.hs
View File

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

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

@ -124,8 +124,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 =

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

@ -66,6 +66,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)
@ -347,7 +348,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
@ -465,7 +466,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 ()
@ -487,11 +488,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'
@ -510,11 +511,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,
@ -616,9 +617,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
@ -687,21 +688,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
@ -1564,7 +1551,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
@ -1711,7 +1698,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

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

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

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

@ -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
@ -23,27 +23,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
}

33
unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs Normal file
View File

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

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

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

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

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

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

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

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

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

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

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

4
unison-cli/src/Unison/CommandLine/BranchRelativePath.hs
View File

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

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

@ -2753,19 +2753,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
@ -3822,7 +3824,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
@ -3838,7 +3841,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)

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

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

13
unison-core/src/Unison/HashQualified'.hs
View File

@ -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)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.Prelude
@ -113,14 +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 (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

8
unison-core/src/Unison/HashQualified.hs
View File

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

11
unison-core/src/Unison/Name.hs
View File

@ -1,7 +1,5 @@
module Unison.Name
( Name,
Convert (..),
Parse (..),
-- * Basic construction
cons,
@ -570,12 +568,3 @@ commonPrefix x@(Name p1 _) y@(Name p2 _)
commonPrefix' (a : as) (b : bs)
| a == b = a : commonPrefix' as bs
commonPrefix' _ _ = []
class Convert a b where
convert :: a -> b
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

25
unison-core/src/Unison/Name/Internal.hs
View File

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

2
unison-core/src/Unison/NamesWithHistory.hs
View File

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

5
unison-core/src/Unison/Term.hs
View File

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

3
unison-core/src/Unison/Type/Names.hs
View File

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

38
unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs
View File

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

122
unison-merge/src/Unison/Merge/Diff.hs
View File

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

15
unison-merge/src/Unison/Merge/PartialDeclNameLookup.hs Normal file
View File

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

48
unison-merge/src/Unison/Merge/Synhash.hs
View File

@ -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
hashHQNameToken . PPE.termNameOrHashOnlyFq 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)
-- | 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

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

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

4
unison-share-api/src/Unison/Server/Backend.hs
View File

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

20
unison-src/transcripts-manual/docs.to-html.md Normal file
View File

@ -0,0 +1,20 @@
```ucm
.> project.create test-html-docs
test-html-docs/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-html-docs/main> add
test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html
```

75
unison-src/transcripts-manual/docs.to-html.output.md Normal file
View File

@ -0,0 +1,75 @@
```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 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-html-docs/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-html-docs/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-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html
```

1
unison-src/transcripts-manual/docs.to-html/direct/doc.html Normal file
View File

@ -0,0 +1 @@
<article class="unison-doc"><span class="span"><span class="word">A doc directly in the namespace.</span></span><div class="tooltips" style="display: none;"></div></article>

1
unison-src/transcripts-manual/docs.to-html/pretty/deeply/nested/doc.html Normal file
View File

@ -0,0 +1 @@
<article class="unison-doc"><span class="span"><span class="word">A doc pretty deeply nested in the namespace.</span></span><div class="tooltips" style="display: none;"></div></article>

83
unison-src/transcripts-round-trip/main.output.md
View File

@ -24,7 +24,7 @@ So we can see the pretty-printed output:
☝️
I added 105 definitions to the top of scratch.u
I added 109 definitions to the top of scratch.u
You can edit them there, then run `update` to replace the
definitions currently in this namespace.
@ -168,7 +168,7 @@ fix_2271 =
# Full doc body indented
``` raw
myVal1 = 42
myVal1 = 42
myVal2 = 43
myVal4 = 44
```
@ -331,6 +331,85 @@ fix_4384e =
}}
}}
fix_4727 : Doc2
fix_4727 = {{ `` 0xs900dc0ffee `` }}
fix_4729a : Doc2
fix_4729a =
{{
# H1A
## H2A
```
{{
# H1B
## B2B
}}
```
## H2A
}}
fix_4729b : Doc2
fix_4729b =
{{
# H1A
## H2A
{{ docTable
[[{{
# HA
}}, {{
# HB
}}], [{{
# a
}}, {{
# b
}}]] }}
## H2A
}}
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

117
unison-src/transcripts-round-trip/reparses-with-same-hash.u
View File

@ -1,5 +1,5 @@
-- A very simple example to start
-- A very simple example to start
simplestPossibleExample = 1 + 1
-- Destructuring binds
@ -73,7 +73,7 @@ Abort.toDefault! default thunk =
h x = Abort.toDefault! (handler_1778 default x) thunk
handle (thunk ()) with h
fix_1778 =
fix_1778 =
'(let
abort
0) |> Abort.toOptional
@ -91,19 +91,19 @@ fix_1536 = 'let
fix_2271 : Doc2
fix_2271 =
{{ # Full doc body indented
``` raw
myVal1 = 42
myVal1 = 42
myVal2 = 43
myVal4 = 44
```
``` raw
indented1= "hi"
indented2="this is two indents"
```
I am two spaces over
I am two spaces over
}}
@ -156,7 +156,7 @@ fix_525_exampleTerm quaffle = Fix_525.bar.quaffle + 1
-- This demonstrates the same thing for types.
-- exampleType's signature locally binds the 'qualifiedName' type parameter,
-- so the pretty-printer should use the longer name 'Fully.qualifiedName'
-- so the pretty-printer should use the longer name 'Fully.qualifiedName'
structural type Fully.qualifiedName = Dontcare () Nat
structural type Id a = Id a
@ -166,10 +166,10 @@ fix_525_exampleType z = Id (Dontcare () 19)
-- We'd get a type error if `exampleTerm` or `exampleType` didn't round-trip, but it typechecks okay!
-- Use clauses can't introduce shadowing
-- Use clauses can't introduce shadowing
use_clauses_example : Int -> Text -> Nat
use_clauses_example oo quaffle =
use_clauses_example oo quaffle =
Fix_525.bar.quaffle + Fix_525.bar.quaffle + 1
use_clauses_example2 : Int -> Nat
@ -193,29 +193,29 @@ Foo'.bar.qux2 = "45"
Foo.bar.qux3 = 46
Foo'.bar.qux3 = "47"
ex1 =
ex1 =
a = Foo.bar.qux3 + Foo.bar.qux3
Foo.bar.qux1 + Foo.bar.qux1 + Foo.bar.qux2
ex2 =
a =
ex2 =
a =
-- use Foo.bar qux3 will get pushed in here since it's already a multiline block
z = 203993
Foo.bar.qux3 + Foo.bar.qux3
Foo.bar.qux1 + Foo.bar.qux1 + Foo.bar.qux2
ex3 =
ex3 =
a = do
-- use clause gets pushed in here
x = Foo.bar.qux3 + Foo.bar.qux3
x + x
()
ex3a =
ex3a =
a = do Foo.bar.qux3 + Foo.bar.qux3 -- use clause will get pulled up to top level
()
-- Make sure use clauses don't show up before a soft hang
-- Make sure use clauses don't show up before a soft hang
-- Regression test for https://github.com/unisonweb/unison/issues/3883
structural type UUID = UUID Nat (Nat, Nat)
@ -249,7 +249,7 @@ raw_d = """
"""
-- Fix for wonky treatment of abilities with multi-segment constructor names
-- Fix for wonky treatment of abilities with multi-segment constructor names
-- Regression test for https://github.com/unisonweb/unison/issues/3239
structural ability Zoink where
@ -387,14 +387,14 @@ softhang21a = handle
{ a } -> "lskdfjlaksjdf al;ksdjf;lkj sa;sldkfja;sldfkj a;lsdkfj asd;lfkj "
{ Abort.abort -> _ } -> "lskdfjlaksjdf al;ksdjf;lkj sa;sldkfja;sldfkj a;lsdkfj asd;lfkj "
softhang2 x f = 0
softhang2 x f = 0
softhang22 = softhang2 [0,1,2,3,4,5] cases
0 -> 0
1 -> 1
n -> n + 100
catchAll x =
catchAll x =
99
softhang23 = do
@ -416,13 +416,13 @@ softhang26 = softhang2 [1,2,3,4] cases
0 -> 1
n -> n + 1
forkAt loc c =
forkAt loc c =
x = 99
390439034
390439034
softhang27 somewhere = forkAt somewhere do
x = 1
y = 2
y = 2
x + y
softhang28 = softhang2 [0,1,2,3,4,5] cases
@ -432,13 +432,13 @@ softhang28 = softhang2 [0,1,2,3,4,5] cases
-- Weirdness reported by Stew with super long lines
longlines x =
longlines x =
u = 92393
x
longlines_helper x = do x
longlines1 = do
longlines1 = do
longlines !(longlines_helper "This has to laksdjf alsdkfj alskdjf asdf be a long enough string to force a line break")
longlines2 =
@ -456,7 +456,7 @@ test3 = do
-- Regression test for https://github.com/unisonweb/unison/issues/4239
-- `n` was replaced by `error` but should not be. Instead, render as if
-- a second param, _, had been provided in the definition.
-- a second param, _, had been provided in the definition.
(>>>>) : Nat -> Nat -> ()
(>>>>) n = cases
_ -> bug ""
@ -472,11 +472,11 @@ fix_4352 = {{``+1``}}
-- regression test to make sure we don't use soft hang between a `do` and `match`
-- if there's imports that have been inserted there
structural ability Ask a where
ask : a
structural ability Ask a where
ask : a
Decode.remainder : '{Ask (Optional Bytes)} Bytes
Decode.remainder = do
Decode.remainder = do
use Bytes ++
match ask with
None -> Bytes.empty
@ -488,7 +488,7 @@ fix_4340 = HandlerWebSocket cases
1 -> "hi sdflkj sdlfkjsdflkj sldfkj sldkfj sdf asdlkfjs dlfkj sldfkj sdf"
_ -> abort
fix_4258 x y z =
fix_4258 x y z =
_ = "fix_4258"
()
@ -497,26 +497,26 @@ fix_4258_example = fix_4258 1 () 2
-- previously, lexer was emitting virtual semicolons inside parens, which
-- led to some very odd parse errors in cases like these
stew_issue =
stew_issue =
error x = ()
(++) a b = 0
toText a = a
Debug : a -> b -> ()
Debug a b = ()
error
(Debug None '(Debug "Failed " -- virtual semicolon here was tripping up parser
(Debug None '(Debug "Failed " -- virtual semicolon here was tripping up parser
42))
stew_issue2 =
stew_issue2 =
error x = ()
(++) a b = 0
toText a = a
Debug : a -> b -> ()
Debug a b = ()
error
(Debug None '("Failed " ++
(Debug None '("Failed " ++
toText 42))
stew_issue3 =
stew_issue3 =
id x = x
error x = ()
(++) a b = 0
@ -525,7 +525,7 @@ stew_issue3 =
configPath = 0
Debug a b = ()
error
(Debug None '("Failed to get timestamp of config file " ++
(Debug None '("Failed to get timestamp of config file " ++
toText configPath))
fix_4384 = {{ {{ docExampleBlock 0 do 2 }} }}
@ -539,7 +539,50 @@ fix_4384c = {{ {{ docExampleBlock 0 do
fix_4384d = {{ {{ docExampleBlock 0 '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18] }} }}
fix_4384e =
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) }} }}
fix_4727 = {{ `` 0xs900dc0ffee `` }}
fix_4729a = {{
# H1A
## H2A
```
{{
# H1B
## B2B
}}
```
## H2A
}}
fix_4729b = {{
# H1A
## H2A
{{ docTable [
[ {{ # HA }}, {{ # HB }} ],
[ {{ ## a }}, {{ ## b }} ]
] }}
## H2A
}}
fix_4729c = {{
# Examples
```
docCallout
(Some
{{
# Title
}}) {{ This is a callout with a title }}
```
}}

14
unison-src/transcripts/error-messages.output.md
View File

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

4
unison-src/transcripts/generic-parse-errors.output.md
View File

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

105
unison-src/transcripts/merge.md
View File

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

99
unison-src/transcripts/merge.output.md
View File

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

6
unison-syntax/src/Unison/Syntax/HashQualified'.hs
View File

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

6
unison-syntax/src/Unison/Syntax/HashQualified.hs
View File

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

59
unison-syntax/src/Unison/Syntax/Lexer.hs
View File

@ -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 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)
@ -95,8 +102,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
@ -224,7 +230,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 +240,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, _) : _) =
@ -303,7 +315,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]
@ -423,13 +435,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 ())
@ -808,12 +827,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

8
unison-syntax/test/Main.hs
View File

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