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

Merge pull request #5068 from unisonweb/24-05-30-edit-namespace-no-record-accessors

Browse Source
This commit is contained in:
Arya Irani 2024-06-10 16:22:35 -04:00 committed by GitHub
commit 433be000b2
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
5 changed files with 178 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs
View File

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

71
parser-typechecker/src/Unison/Syntax/DeclPrinter.hs
View File

@ -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
--
-- This function bails with `Nothing` if the names aren't an exact match for
-- the expected record naming convention.
fieldNames ::
-- `x`, `y`
--
-- 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

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

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

22
unison-src/transcripts/edit-namespace.md
View File

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

83
unison-src/transcripts/edit-namespace.output.md
View File

@ -12,43 +12,76 @@ simple.y = 20
-- Shouldn't edit things in lib
lib.project.ignoreMe = 30
-- Shouldn't render record accessors
unique type Foo = { bar : Nat, baz : Nat }
```
Edit current namespace
```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
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
```
```ucm
project/main> add
⍟ 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.namespace` edits the whole namespace (minus the top-level `lib`).
```ucm
.simple> edit.namespace
project/main> edit.namespace
☝️
I added 2 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
x : ##Nat
x = 10
type Foo = { bar : Nat, baz : Nat }
y : ##Nat
y = 20
```
Edit should hit things recursively
```ucm
.> edit.namespace
☝️
I added 7 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
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
☝️