mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
report constructor aliases in todo
This commit is contained in:
parent
fdf91bbce6
commit
06b731b774
@ -4,6 +4,7 @@ module Unison.Codebase.Editor.HandleInput.Todo
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Either qualified as Either
|
||||
import Data.Set qualified as Set
|
||||
import U.Codebase.HashTags (BranchHash (..))
|
||||
import U.Codebase.Sqlite.Operations qualified as Operations
|
||||
@ -19,6 +20,7 @@ import Unison.Codebase.Causal qualified as Causal
|
||||
import Unison.Codebase.Editor.HandleInput.Merge2 (hasDefnsInLib)
|
||||
import Unison.Codebase.Editor.Output
|
||||
import Unison.Hash (HashFor (..))
|
||||
import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..), checkAllDeclCoherency)
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Prelude
|
||||
import Unison.Reference (TermReference)
|
||||
@ -34,7 +36,7 @@ handleTodo = do
|
||||
let currentNamespace = Branch.head currentCausal
|
||||
let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace
|
||||
|
||||
(defnsInLib, dependentsOfTodo, directDependencies, hashLen) <-
|
||||
(defnsInLib, dependentsOfTodo, directDependencies, hashLen, incoherentDeclReasons) <-
|
||||
Cli.runTransaction do
|
||||
-- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand
|
||||
defnsInLib <- do
|
||||
@ -66,21 +68,28 @@ handleTodo = do
|
||||
|
||||
hashLen <- Codebase.hashLength
|
||||
|
||||
pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen)
|
||||
incoherentDeclReasons <-
|
||||
fmap (Either.fromLeft (IncoherentDeclReasons [] [] [] [])) $
|
||||
checkAllDeclCoherency
|
||||
Operations.expectDeclNumConstructors
|
||||
(Names.lenientToNametree (Branch.toNames currentNamespaceWithoutLibdeps))
|
||||
|
||||
pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen, incoherentDeclReasons)
|
||||
|
||||
ppe <- Cli.currentPrettyPrintEnvDecl
|
||||
|
||||
Cli.respondNumbered $
|
||||
Output'Todo
|
||||
TodoOutput
|
||||
{ hashLen,
|
||||
defnsInLib,
|
||||
{ defnsInLib,
|
||||
dependentsOfTodo,
|
||||
directDependenciesWithoutNames =
|
||||
Defns
|
||||
{ terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace),
|
||||
types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace)
|
||||
},
|
||||
hashLen,
|
||||
incoherentDeclReasons,
|
||||
nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps),
|
||||
ppe
|
||||
}
|
||||
|
@ -53,9 +53,11 @@ import Unison.DataDeclaration.ConstructorId (ConstructorId)
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.LabeledDependency (LabeledDependency)
|
||||
import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..))
|
||||
import Unison.Name (Name)
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Names (Names)
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Names.ResolutionResult qualified as Names
|
||||
import Unison.NamesWithHistory qualified as Names
|
||||
import Unison.Parser.Ann (Ann)
|
||||
@ -82,7 +84,6 @@ import Unison.Util.Defns (DefnsF, defnsAreEmpty)
|
||||
import Unison.Util.Pretty qualified as P
|
||||
import Unison.Util.Relation (Relation)
|
||||
import Unison.WatchKind qualified as WK
|
||||
import qualified Unison.Names as Names
|
||||
|
||||
type ListDetailed = Bool
|
||||
|
||||
@ -157,6 +158,7 @@ data TodoOutput = TodoOutput
|
||||
dependentsOfTodo :: !(Set TermReferenceId),
|
||||
directDependenciesWithoutNames :: !(DefnsF Set TermReference TypeReference),
|
||||
hashLen :: !Int,
|
||||
incoherentDeclReasons :: !IncoherentDeclReasons,
|
||||
nameConflicts :: !Names,
|
||||
ppe :: !PrettyPrintEnvDecl
|
||||
}
|
||||
@ -167,6 +169,7 @@ todoOutputIsEmpty todo =
|
||||
&& defnsAreEmpty todo.directDependenciesWithoutNames
|
||||
&& Names.isEmpty todo.nameConflicts
|
||||
&& not todo.defnsInLib
|
||||
&& todo.incoherentDeclReasons == IncoherentDeclReasons [] [] [] []
|
||||
|
||||
data AmbiguousReset'Argument
|
||||
= AmbiguousReset'Hash
|
||||
|
@ -87,6 +87,7 @@ import Unison.Hash32 (Hash32)
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.LabeledDependency as LD
|
||||
import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..))
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
@ -1405,6 +1406,7 @@ notifyUser dir = \case
|
||||
pure . P.lines $
|
||||
[ P.wrap "Sorry, I wasn't able to perform the merge:",
|
||||
"",
|
||||
-- Note [ConstructorAliasMessage] If you change this, also change the other similar one
|
||||
P.wrap $
|
||||
"On"
|
||||
<> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
||||
@ -2728,12 +2730,39 @@ handleTodoOutput todo
|
||||
<> "subnamespaces representing library dependencies. Please move or remove it."
|
||||
else mempty
|
||||
|
||||
prettyConstructorAliases <-
|
||||
if null todo.incoherentDeclReasons.constructorAliases
|
||||
then pure mempty
|
||||
else do
|
||||
things <-
|
||||
for todo.incoherentDeclReasons.constructorAliases \(typeName, conName1, conName2) -> do
|
||||
n1 <- addNumberedArg (SA.Name conName1)
|
||||
n2 <- addNumberedArg (SA.Name conName2)
|
||||
pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2)
|
||||
pure $
|
||||
things
|
||||
& map
|
||||
( \(typeName, prettyCon1, prettyCon2) ->
|
||||
-- Note [ConstructorAliasMessage] If you change this, also change the other similar one
|
||||
P.wrap
|
||||
( "The type"
|
||||
<> prettyName typeName
|
||||
<> "has a constructor with multiple names. Please delete all but one name for each"
|
||||
<> "constructor."
|
||||
)
|
||||
<> P.newline
|
||||
<> P.newline
|
||||
<> P.indentN 2 (P.lines [prettyCon1, prettyCon2])
|
||||
)
|
||||
& P.sep "\n\n"
|
||||
|
||||
(pure . P.sep "\n\n" . P.nonEmpty)
|
||||
[ prettyDependentsOfTodo,
|
||||
prettyDirectTermDependenciesWithoutNames,
|
||||
prettyDirectTypeDependenciesWithoutNames,
|
||||
prettyConflicts,
|
||||
prettyDefnsInLib
|
||||
prettyDefnsInLib,
|
||||
prettyConstructorAliases
|
||||
]
|
||||
|
||||
listOfDefinitions ::
|
||||
|
@ -83,6 +83,10 @@ module Unison.Merge.DeclCoherencyCheck
|
||||
( IncoherentDeclReason (..),
|
||||
checkDeclCoherency,
|
||||
lenientCheckDeclCoherency,
|
||||
|
||||
-- * Getting all failures rather than just the first
|
||||
IncoherentDeclReasons (..),
|
||||
checkAllDeclCoherency,
|
||||
)
|
||||
where
|
||||
|
||||
@ -147,6 +151,53 @@ checkDeclCoherency loadDeclNumConstructors nametree =
|
||||
nametree
|
||||
)
|
||||
|
||||
data IncoherentDeclReasons = IncoherentDeclReasons
|
||||
{ constructorAliases :: ![(Name, Name, Name)],
|
||||
missingConstructorNames :: ![Name],
|
||||
nestedDeclAliases :: ![(Name, Name)],
|
||||
strayConstructors :: ![Name]
|
||||
}
|
||||
deriving stock (Eq, Generic)
|
||||
|
||||
-- | Like 'checkDeclCoherency', but returns info about all of the incoherent decls found, not just the first.
|
||||
checkAllDeclCoherency ::
|
||||
forall m.
|
||||
Monad m =>
|
||||
(TypeReferenceId -> m Int) ->
|
||||
Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
|
||||
m (Either IncoherentDeclReasons DeclNameLookup)
|
||||
checkAllDeclCoherency loadDeclNumConstructors nametree = do
|
||||
State.runStateT doCheck emptyReasons <&> \(declNameLookup, reasons) ->
|
||||
if reasons == emptyReasons
|
||||
then Right declNameLookup
|
||||
else Left (reverseReasons reasons)
|
||||
where
|
||||
doCheck :: StateT IncoherentDeclReasons m DeclNameLookup
|
||||
doCheck =
|
||||
checkDeclCoherencyWith
|
||||
(lift . loadDeclNumConstructors)
|
||||
( OnIncoherentDeclReasons
|
||||
{ onConstructorAlias = \x y z -> #constructorAliases %= ((x, y, z) :),
|
||||
onMissingConstructorName = \x -> #missingConstructorNames %= (x :),
|
||||
onNestedDeclAlias = \x y -> #nestedDeclAliases %= ((x, y) :),
|
||||
onStrayConstructor = \x -> #strayConstructors %= (x :)
|
||||
}
|
||||
)
|
||||
nametree
|
||||
|
||||
emptyReasons :: IncoherentDeclReasons
|
||||
emptyReasons =
|
||||
IncoherentDeclReasons [] [] [] []
|
||||
|
||||
reverseReasons :: IncoherentDeclReasons -> IncoherentDeclReasons
|
||||
reverseReasons reasons =
|
||||
IncoherentDeclReasons
|
||||
{ constructorAliases = reverse reasons.constructorAliases,
|
||||
missingConstructorNames = reverse reasons.missingConstructorNames,
|
||||
nestedDeclAliases = reverse reasons.nestedDeclAliases,
|
||||
strayConstructors = reverse reasons.strayConstructors
|
||||
}
|
||||
|
||||
data OnIncoherentDeclReasons m = OnIncoherentDeclReasons
|
||||
{ onConstructorAlias :: Name -> Name -> Name -> m (),
|
||||
onMissingConstructorName :: Name -> m (),
|
||||
@ -171,22 +222,22 @@ checkDeclCoherencyWith loadDeclNumConstructors callbacks =
|
||||
(Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
|
||||
StateT DeclCoherencyCheckState m ()
|
||||
go prefix (Nametree defns children) = do
|
||||
for_ (Map.toList defns.terms) (checkDeclCoherency_terms callbacks prefix)
|
||||
for_ (Map.toList defns.terms) (checkDeclCoherencyWith_DoTerms callbacks prefix)
|
||||
childrenWeWentInto <-
|
||||
forMaybe
|
||||
(Map.toList defns.types)
|
||||
(checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children)
|
||||
(checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children)
|
||||
let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto
|
||||
for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child
|
||||
|
||||
checkDeclCoherency_terms ::
|
||||
checkDeclCoherencyWith_DoTerms ::
|
||||
forall m.
|
||||
Monad m =>
|
||||
OnIncoherentDeclReasons m ->
|
||||
[NameSegment] ->
|
||||
(NameSegment, Referent) ->
|
||||
StateT DeclCoherencyCheckState m ()
|
||||
checkDeclCoherency_terms callbacks prefix = \case
|
||||
checkDeclCoherencyWith_DoTerms callbacks prefix = \case
|
||||
(_, Referent.Ref _) -> pure ()
|
||||
(_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure ()
|
||||
(name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do
|
||||
@ -209,7 +260,7 @@ checkDeclCoherency_terms callbacks prefix = \case
|
||||
name1 =
|
||||
Name.fromReverseSegments (name :| prefix)
|
||||
|
||||
checkDeclCoherency_types ::
|
||||
checkDeclCoherencyWith_DoTypes ::
|
||||
forall m.
|
||||
Monad m =>
|
||||
(TypeReferenceId -> m Int) ->
|
||||
@ -222,7 +273,7 @@ checkDeclCoherency_types ::
|
||||
Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
|
||||
(NameSegment, TypeReference) ->
|
||||
StateT DeclCoherencyCheckState m (Maybe NameSegment)
|
||||
checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children = \case
|
||||
checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children = \case
|
||||
(_, ReferenceBuiltin _) -> pure Nothing
|
||||
(name, ReferenceDerived typeRef) -> do
|
||||
state <- State.get
|
||||
|
@ -98,3 +98,25 @@ scratch/main> todo
|
||||
```ucm:hide
|
||||
scratch/main> delete.project scratch
|
||||
```
|
||||
|
||||
# Constructor aliases
|
||||
|
||||
The `todo` command complains about constructor aliases.
|
||||
|
||||
```ucm:hide
|
||||
scratch/main> builtins.mergeio lib.builtins
|
||||
```
|
||||
|
||||
```unison
|
||||
type Foo = One
|
||||
```
|
||||
|
||||
```ucm
|
||||
scratch/main> add
|
||||
scratch/main> alias.term Foo.One Foo.Two
|
||||
scratch/main> todo
|
||||
```
|
||||
|
||||
```ucm:hide
|
||||
scratch/main> delete.project scratch
|
||||
```
|
||||
|
@ -181,3 +181,44 @@ scratch/main> todo
|
||||
representing library dependencies. Please move or remove it.
|
||||
|
||||
```
|
||||
# Constructor aliases
|
||||
|
||||
The `todo` command complains about constructor aliases.
|
||||
|
||||
```unison
|
||||
type Foo = One
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
type Foo
|
||||
|
||||
```
|
||||
```ucm
|
||||
scratch/main> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
type Foo
|
||||
|
||||
scratch/main> alias.term Foo.One Foo.Two
|
||||
|
||||
Done.
|
||||
|
||||
scratch/main> todo
|
||||
|
||||
The type Foo has a constructor with multiple names. Please
|
||||
delete all but one name for each constructor.
|
||||
|
||||
1. Foo.One
|
||||
2. Foo.Two
|
||||
|
||||
```
|
||||
|
Loading…
Reference in New Issue
Block a user