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
|
where
|
||||||
|
|
||||||
|
import Data.Either qualified as Either
|
||||||
import Data.Set qualified as Set
|
import Data.Set qualified as Set
|
||||||
import U.Codebase.HashTags (BranchHash (..))
|
import U.Codebase.HashTags (BranchHash (..))
|
||||||
import U.Codebase.Sqlite.Operations qualified as Operations
|
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.HandleInput.Merge2 (hasDefnsInLib)
|
||||||
import Unison.Codebase.Editor.Output
|
import Unison.Codebase.Editor.Output
|
||||||
import Unison.Hash (HashFor (..))
|
import Unison.Hash (HashFor (..))
|
||||||
|
import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..), checkAllDeclCoherency)
|
||||||
import Unison.Names qualified as Names
|
import Unison.Names qualified as Names
|
||||||
import Unison.Prelude
|
import Unison.Prelude
|
||||||
import Unison.Reference (TermReference)
|
import Unison.Reference (TermReference)
|
||||||
@ -34,7 +36,7 @@ handleTodo = do
|
|||||||
let currentNamespace = Branch.head currentCausal
|
let currentNamespace = Branch.head currentCausal
|
||||||
let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace
|
let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace
|
||||||
|
|
||||||
(defnsInLib, dependentsOfTodo, directDependencies, hashLen) <-
|
(defnsInLib, dependentsOfTodo, directDependencies, hashLen, incoherentDeclReasons) <-
|
||||||
Cli.runTransaction do
|
Cli.runTransaction do
|
||||||
-- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand
|
-- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand
|
||||||
defnsInLib <- do
|
defnsInLib <- do
|
||||||
@ -66,21 +68,28 @@ handleTodo = do
|
|||||||
|
|
||||||
hashLen <- Codebase.hashLength
|
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
|
ppe <- Cli.currentPrettyPrintEnvDecl
|
||||||
|
|
||||||
Cli.respondNumbered $
|
Cli.respondNumbered $
|
||||||
Output'Todo
|
Output'Todo
|
||||||
TodoOutput
|
TodoOutput
|
||||||
{ hashLen,
|
{ defnsInLib,
|
||||||
defnsInLib,
|
|
||||||
dependentsOfTodo,
|
dependentsOfTodo,
|
||||||
directDependenciesWithoutNames =
|
directDependenciesWithoutNames =
|
||||||
Defns
|
Defns
|
||||||
{ terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace),
|
{ terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace),
|
||||||
types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace)
|
types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace)
|
||||||
},
|
},
|
||||||
|
hashLen,
|
||||||
|
incoherentDeclReasons,
|
||||||
nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps),
|
nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps),
|
||||||
ppe
|
ppe
|
||||||
}
|
}
|
||||||
|
@ -53,9 +53,11 @@ import Unison.DataDeclaration.ConstructorId (ConstructorId)
|
|||||||
import Unison.HashQualified qualified as HQ
|
import Unison.HashQualified qualified as HQ
|
||||||
import Unison.HashQualified' qualified as HQ'
|
import Unison.HashQualified' qualified as HQ'
|
||||||
import Unison.LabeledDependency (LabeledDependency)
|
import Unison.LabeledDependency (LabeledDependency)
|
||||||
|
import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..))
|
||||||
import Unison.Name (Name)
|
import Unison.Name (Name)
|
||||||
import Unison.NameSegment (NameSegment)
|
import Unison.NameSegment (NameSegment)
|
||||||
import Unison.Names (Names)
|
import Unison.Names (Names)
|
||||||
|
import Unison.Names qualified as Names
|
||||||
import Unison.Names.ResolutionResult qualified as Names
|
import Unison.Names.ResolutionResult qualified as Names
|
||||||
import Unison.NamesWithHistory qualified as Names
|
import Unison.NamesWithHistory qualified as Names
|
||||||
import Unison.Parser.Ann (Ann)
|
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.Pretty qualified as P
|
||||||
import Unison.Util.Relation (Relation)
|
import Unison.Util.Relation (Relation)
|
||||||
import Unison.WatchKind qualified as WK
|
import Unison.WatchKind qualified as WK
|
||||||
import qualified Unison.Names as Names
|
|
||||||
|
|
||||||
type ListDetailed = Bool
|
type ListDetailed = Bool
|
||||||
|
|
||||||
@ -157,6 +158,7 @@ data TodoOutput = TodoOutput
|
|||||||
dependentsOfTodo :: !(Set TermReferenceId),
|
dependentsOfTodo :: !(Set TermReferenceId),
|
||||||
directDependenciesWithoutNames :: !(DefnsF Set TermReference TypeReference),
|
directDependenciesWithoutNames :: !(DefnsF Set TermReference TypeReference),
|
||||||
hashLen :: !Int,
|
hashLen :: !Int,
|
||||||
|
incoherentDeclReasons :: !IncoherentDeclReasons,
|
||||||
nameConflicts :: !Names,
|
nameConflicts :: !Names,
|
||||||
ppe :: !PrettyPrintEnvDecl
|
ppe :: !PrettyPrintEnvDecl
|
||||||
}
|
}
|
||||||
@ -167,6 +169,7 @@ todoOutputIsEmpty todo =
|
|||||||
&& defnsAreEmpty todo.directDependenciesWithoutNames
|
&& defnsAreEmpty todo.directDependenciesWithoutNames
|
||||||
&& Names.isEmpty todo.nameConflicts
|
&& Names.isEmpty todo.nameConflicts
|
||||||
&& not todo.defnsInLib
|
&& not todo.defnsInLib
|
||||||
|
&& todo.incoherentDeclReasons == IncoherentDeclReasons [] [] [] []
|
||||||
|
|
||||||
data AmbiguousReset'Argument
|
data AmbiguousReset'Argument
|
||||||
= AmbiguousReset'Hash
|
= AmbiguousReset'Hash
|
||||||
|
@ -87,6 +87,7 @@ import Unison.Hash32 (Hash32)
|
|||||||
import Unison.HashQualified qualified as HQ
|
import Unison.HashQualified qualified as HQ
|
||||||
import Unison.HashQualified' qualified as HQ'
|
import Unison.HashQualified' qualified as HQ'
|
||||||
import Unison.LabeledDependency as LD
|
import Unison.LabeledDependency as LD
|
||||||
|
import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..))
|
||||||
import Unison.Name (Name)
|
import Unison.Name (Name)
|
||||||
import Unison.Name qualified as Name
|
import Unison.Name qualified as Name
|
||||||
import Unison.NameSegment qualified as NameSegment
|
import Unison.NameSegment qualified as NameSegment
|
||||||
@ -1405,6 +1406,7 @@ notifyUser dir = \case
|
|||||||
pure . P.lines $
|
pure . P.lines $
|
||||||
[ P.wrap "Sorry, I wasn't able to perform the merge:",
|
[ 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 $
|
P.wrap $
|
||||||
"On"
|
"On"
|
||||||
<> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
<> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
||||||
@ -2728,12 +2730,39 @@ handleTodoOutput todo
|
|||||||
<> "subnamespaces representing library dependencies. Please move or remove it."
|
<> "subnamespaces representing library dependencies. Please move or remove it."
|
||||||
else mempty
|
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)
|
(pure . P.sep "\n\n" . P.nonEmpty)
|
||||||
[ prettyDependentsOfTodo,
|
[ prettyDependentsOfTodo,
|
||||||
prettyDirectTermDependenciesWithoutNames,
|
prettyDirectTermDependenciesWithoutNames,
|
||||||
prettyDirectTypeDependenciesWithoutNames,
|
prettyDirectTypeDependenciesWithoutNames,
|
||||||
prettyConflicts,
|
prettyConflicts,
|
||||||
prettyDefnsInLib
|
prettyDefnsInLib,
|
||||||
|
prettyConstructorAliases
|
||||||
]
|
]
|
||||||
|
|
||||||
listOfDefinitions ::
|
listOfDefinitions ::
|
||||||
|
@ -83,6 +83,10 @@ module Unison.Merge.DeclCoherencyCheck
|
|||||||
( IncoherentDeclReason (..),
|
( IncoherentDeclReason (..),
|
||||||
checkDeclCoherency,
|
checkDeclCoherency,
|
||||||
lenientCheckDeclCoherency,
|
lenientCheckDeclCoherency,
|
||||||
|
|
||||||
|
-- * Getting all failures rather than just the first
|
||||||
|
IncoherentDeclReasons (..),
|
||||||
|
checkAllDeclCoherency,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -147,6 +151,53 @@ checkDeclCoherency loadDeclNumConstructors nametree =
|
|||||||
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
|
data OnIncoherentDeclReasons m = OnIncoherentDeclReasons
|
||||||
{ onConstructorAlias :: Name -> Name -> Name -> m (),
|
{ onConstructorAlias :: Name -> Name -> Name -> m (),
|
||||||
onMissingConstructorName :: Name -> m (),
|
onMissingConstructorName :: Name -> m (),
|
||||||
@ -171,22 +222,22 @@ checkDeclCoherencyWith loadDeclNumConstructors callbacks =
|
|||||||
(Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
|
(Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
|
||||||
StateT DeclCoherencyCheckState m ()
|
StateT DeclCoherencyCheckState m ()
|
||||||
go prefix (Nametree defns children) = do
|
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 <-
|
childrenWeWentInto <-
|
||||||
forMaybe
|
forMaybe
|
||||||
(Map.toList defns.types)
|
(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
|
let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto
|
||||||
for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child
|
for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child
|
||||||
|
|
||||||
checkDeclCoherency_terms ::
|
checkDeclCoherencyWith_DoTerms ::
|
||||||
forall m.
|
forall m.
|
||||||
Monad m =>
|
Monad m =>
|
||||||
OnIncoherentDeclReasons m ->
|
OnIncoherentDeclReasons m ->
|
||||||
[NameSegment] ->
|
[NameSegment] ->
|
||||||
(NameSegment, Referent) ->
|
(NameSegment, Referent) ->
|
||||||
StateT DeclCoherencyCheckState m ()
|
StateT DeclCoherencyCheckState m ()
|
||||||
checkDeclCoherency_terms callbacks prefix = \case
|
checkDeclCoherencyWith_DoTerms callbacks prefix = \case
|
||||||
(_, Referent.Ref _) -> pure ()
|
(_, Referent.Ref _) -> pure ()
|
||||||
(_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure ()
|
(_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure ()
|
||||||
(name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do
|
(name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do
|
||||||
@ -209,7 +260,7 @@ checkDeclCoherency_terms callbacks prefix = \case
|
|||||||
name1 =
|
name1 =
|
||||||
Name.fromReverseSegments (name :| prefix)
|
Name.fromReverseSegments (name :| prefix)
|
||||||
|
|
||||||
checkDeclCoherency_types ::
|
checkDeclCoherencyWith_DoTypes ::
|
||||||
forall m.
|
forall m.
|
||||||
Monad m =>
|
Monad m =>
|
||||||
(TypeReferenceId -> m Int) ->
|
(TypeReferenceId -> m Int) ->
|
||||||
@ -222,7 +273,7 @@ checkDeclCoherency_types ::
|
|||||||
Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
|
Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
|
||||||
(NameSegment, TypeReference) ->
|
(NameSegment, TypeReference) ->
|
||||||
StateT DeclCoherencyCheckState m (Maybe NameSegment)
|
StateT DeclCoherencyCheckState m (Maybe NameSegment)
|
||||||
checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children = \case
|
checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children = \case
|
||||||
(_, ReferenceBuiltin _) -> pure Nothing
|
(_, ReferenceBuiltin _) -> pure Nothing
|
||||||
(name, ReferenceDerived typeRef) -> do
|
(name, ReferenceDerived typeRef) -> do
|
||||||
state <- State.get
|
state <- State.get
|
||||||
|
@ -98,3 +98,25 @@ scratch/main> todo
|
|||||||
```ucm:hide
|
```ucm:hide
|
||||||
scratch/main> delete.project scratch
|
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.
|
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