From f0c53eed282698d0c4cb951548c9b275a71aea65 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Tue, 2 Jul 2024 11:39:11 -0400
Subject: [PATCH 1/9] show "defs in lib" merge precondition violation in `todo`
 output

---
 .../src/Unison/Codebase/Causal.hs             |  5 +-
 .../Codebase/Editor/HandleInput/Merge2.hs     | 22 +++--
 .../Codebase/Editor/HandleInput/Todo.hs       | 22 ++++-
 .../src/Unison/Codebase/Editor/Output.hs      |  4 +-
 .../src/Unison/CommandLine/OutputMessages.hs  | 23 +++--
 unison-src/transcripts/todo.md                | 68 ++++++++++---
 unison-src/transcripts/todo.output.md         | 97 +++++++++++++++++--
 7 files changed, 199 insertions(+), 42 deletions(-)

diff --git a/parser-typechecker/src/Unison/Codebase/Causal.hs b/parser-typechecker/src/Unison/Codebase/Causal.hs
index 8cca62cf0..9bdd08903 100644
--- a/parser-typechecker/src/Unison/Codebase/Causal.hs
+++ b/parser-typechecker/src/Unison/Codebase/Causal.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 
 module Unison.Codebase.Causal
-  ( Causal (currentHash, head, tail, tails),
+  ( Causal (currentHash, valueHash, head, tail, tails),
     pattern One,
     pattern Cons,
     pattern Merge,
@@ -40,7 +40,8 @@ import Unison.Codebase.Causal.Type
         currentHash,
         head,
         tail,
-        tails
+        tails,
+        valueHash
       ),
     before,
     lca,
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs
index ceee0aa83..9289a692d 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs
@@ -8,6 +8,9 @@ module Unison.Codebase.Editor.HandleInput.Merge2
     LcaMergeInfo (..),
     doMerge,
     doMergeLocalBranch,
+
+    -- * API exported for @todo@
+    hasDefnsInLib,
   )
 where
 
@@ -85,6 +88,7 @@ import Unison.Merge.EitherWay (EitherWay (..))
 import Unison.Merge.EitherWayI (EitherWayI (..))
 import Unison.Merge.EitherWayI qualified as EitherWayI
 import Unison.Merge.Libdeps qualified as Merge
+import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup)
 import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs)
 import Unison.Merge.Synhashed (Synhashed (..))
 import Unison.Merge.Synhashed qualified as Synhashed
@@ -138,7 +142,6 @@ import Unison.Util.SyntaxText (SyntaxText')
 import Unison.Var (Var)
 import Witch (unsafeFrom)
 import Prelude hiding (unzip, zip, zipWith)
-import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup)
 
 handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
 handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do
@@ -238,11 +241,7 @@ doMerge info = do
 
       -- Assert that neither Alice nor Bob have defns in lib
       for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do
-        libdeps <-
-          case Map.lookup NameSegment.libSegment branch.children of
-            Nothing -> pure V2.Branch.empty
-            Just libdeps -> Cli.runTransaction libdeps.value
-        when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do
+        whenM (Cli.runTransaction (hasDefnsInLib branch)) do
           done (Output.MergeDefnsInLib who)
 
       -- Load Alice/Bob/LCA definitions and decl name lookups
@@ -485,6 +484,17 @@ loadLibdeps branches = do
           libdepsBranch <- libdepsCausal.value
           pure libdepsBranch.children
 
+------------------------------------------------------------------------------------------------------------------------
+-- Merge precondition violation checks
+
+hasDefnsInLib :: Applicative m => V2.Branch m -> m Bool
+hasDefnsInLib branch = do
+  libdeps <-
+    case Map.lookup NameSegment.libSegment branch.children of
+      Nothing -> pure V2.Branch.empty
+      Just libdeps -> libdeps.value
+  pure (not (Map.null libdeps.terms) || not (Map.null libdeps.types))
+
 ------------------------------------------------------------------------------------------------------------------------
 -- Creating Unison files
 
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs
index 1a8ccf64f..ef58f044b 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs
@@ -5,6 +5,7 @@ module Unison.Codebase.Editor.HandleInput.Todo
 where
 
 import Data.Set qualified as Set
+import U.Codebase.HashTags (BranchHash (..))
 import U.Codebase.Sqlite.Operations qualified as Operations
 import Unison.Builtin qualified as Builtin
 import Unison.Cli.Monad (Cli)
@@ -14,7 +15,10 @@ import Unison.Cli.PrettyPrintUtils qualified as Cli
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Branch.Names qualified as Branch
+import Unison.Codebase.Causal qualified as Causal
+import Unison.Codebase.Editor.HandleInput.Merge2 (hasDefnsInLib)
 import Unison.Codebase.Editor.Output
+import Unison.Hash (HashFor (..))
 import Unison.Names qualified as Names
 import Unison.Prelude
 import Unison.Reference (TermReference)
@@ -26,11 +30,22 @@ handleTodo :: Cli ()
 handleTodo = do
   -- For now, we don't go through any great trouble to seek out the root of the project branch. Just assume the current
   -- namespace is the root, which will be the case unless the user uses `deprecated.cd`.
-  currentNamespace <- Cli.getCurrentBranch0
+  currentCausal <- Cli.getCurrentBranch
+  let currentNamespace = Branch.head currentCausal
   let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace
 
-  (dependentsOfTodo, directDependencies, hashLen) <-
+  (defnsInLib, dependentsOfTodo, directDependencies, hashLen) <-
     Cli.runTransaction do
+      -- We call a shared `hasDefnsLib` helper even though we could easily duplicate the logic with the branch in hand
+      defnsInLib <- do
+        branch <-
+          currentCausal
+            & Branch._history
+            & Causal.valueHash
+            & coerce @_ @BranchHash
+            & Operations.expectBranchByBranchHash
+        hasDefnsInLib branch
+
       let todoReference :: TermReference
           todoReference =
             Set.asSingleton (Names.refTermsNamed Builtin.names (Name.unsafeParseText "todo"))
@@ -51,7 +66,7 @@ handleTodo = do
 
       hashLen <- Codebase.hashLength
 
-      pure (dependentsOfTodo.terms, directDependencies, hashLen)
+      pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen)
 
   ppe <- Cli.currentPrettyPrintEnvDecl
 
@@ -59,6 +74,7 @@ handleTodo = do
     Output'Todo
       TodoOutput
         { hashLen,
+          defnsInLib,
           dependentsOfTodo,
           directDependenciesWithoutNames =
             Defns
diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs
index 1534f42d0..7ee842a07 100644
--- a/unison-cli/src/Unison/Codebase/Editor/Output.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs
@@ -153,7 +153,8 @@ data NumberedOutput
       (Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents.
 
 data TodoOutput = TodoOutput
-  { dependentsOfTodo :: !(Set TermReferenceId),
+  { defnsInLib :: !Bool,
+    dependentsOfTodo :: !(Set TermReferenceId),
     directDependenciesWithoutNames :: !(DefnsF Set TermReference TypeReference),
     hashLen :: !Int,
     nameConflicts :: !Names,
@@ -165,6 +166,7 @@ todoOutputIsEmpty todo =
   Set.null todo.dependentsOfTodo
     && defnsAreEmpty todo.directDependenciesWithoutNames
     && Names.isEmpty todo.nameConflicts
+    && not todo.defnsInLib
 
 data AmbiguousReset'Argument
   = AmbiguousReset'Hash
diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index f17f483ad..0e3b93e5c 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -1423,6 +1423,7 @@ notifyUser dir = \case
         P.wrap $
           "On"
             <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
+            -- Note [DefnsInLibMessage] If you change this, also change the other similar one
             <> "there's a type or term at the top level of the `lib` namespace, where I only expect to find"
             <> "subnamespaces representing library dependencies.",
         "",
@@ -2665,11 +2666,6 @@ handleTodoOutput :: TodoOutput -> Numbered Pretty
 handleTodoOutput todo
   | todoOutputIsEmpty todo = pure "You have no pending todo items. Good work! ✅"
   | otherwise = do
-      prettyConflicts <-
-        if todo.nameConflicts == mempty
-          then pure mempty
-          else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts
-
       prettyDependentsOfTodo <- do
         if Set.null todo.dependentsOfTodo
           then pure mempty
@@ -2718,11 +2714,26 @@ handleTodoOutput todo
                 <> P.newline
                 <> P.indentN 2 (P.lines types)
 
+      prettyConflicts <-
+        if todo.nameConflicts == mempty
+          then pure mempty
+          else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts
+
+      let prettyDefnsInLib =
+            if todo.defnsInLib
+              then
+                P.wrap $
+                  -- Note [DefnsInLibMessage] If you change this, also change the other similar one
+                  "There's a type or term at the top level of the `lib` namespace, where I only expect to find"
+                    <> "subnamespaces representing library dependencies. Please move or remove it."
+              else mempty
+
       (pure . P.sep "\n\n" . P.nonEmpty)
         [ prettyDependentsOfTodo,
           prettyDirectTermDependenciesWithoutNames,
           prettyDirectTypeDependenciesWithoutNames,
-          prettyConflicts
+          prettyConflicts,
+          prettyDefnsInLib
         ]
 
 listOfDefinitions ::
diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md
index b86a36e20..25f99aa40 100644
--- a/unison-src/transcripts/todo.md
+++ b/unison-src/transcripts/todo.md
@@ -3,19 +3,15 @@
 When there's nothing to do, `todo` says this:
 
 ```ucm
-project/main> todo
+scratch/main> todo
 ```
 
-# Conflicted names
-
-The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet).
-
 # Dependents of `todo`
 
 The `todo` command shows local (outside `lib`) terms that directly call `todo`.
 
 ```ucm:hide
-project/main> builtins.mergeio lib.builtins
+scratch/main> builtins.mergeio lib.builtins
 ```
 
 ```unison
@@ -27,12 +23,12 @@ bar = foo + foo
 ```
 
 ```ucm
-project/main> add
-project/main> todo
+scratch/main> add
+scratch/main> todo
 ```
 
 ```ucm:hide
-project/main> delete.project project
+scratch/main> delete.project scratch
 ```
 
 # Direct dependencies without names
@@ -41,7 +37,7 @@ The `todo` command shows hashes of direct dependencies of local (outside `lib`)
 the current namespace.
 
 ```ucm:hide
-project/main> builtins.mergeio lib.builtins
+scratch/main> builtins.mergeio lib.builtins
 ```
 
 ```unison
@@ -50,11 +46,55 @@ baz = foo.bar + foo.bar
 ```
 
 ```ucm
-project/main> add
-project/main> delete.namespace.force foo
-project/main> todo
+scratch/main> add
+scratch/main> delete.namespace.force foo
+scratch/main> todo
 ```
 
 ```ucm:hide
-project/main> delete.project project
+scratch/main> delete.project scratch
+```
+
+# Conflicted names
+
+The `todo` command shows conflicted names.
+
+```ucm:hide
+scratch/main> builtins.mergeio lib.builtins
+```
+
+```unison
+foo = 16
+bar = 17
+```
+
+```ucm
+scratch/main> add
+scratch/main> debug.alias.term.force foo bar
+scratch/main> todo
+```
+
+```ucm:hide
+scratch/main> delete.project scratch
+```
+
+# Definitions in lib
+
+The `todo` command complains about terms and types directly in `lib`.
+
+```ucm:hide
+scratch/main> builtins.mergeio lib.builtins
+```
+
+```unison
+lib.foo = 16
+```
+
+```ucm
+scratch/main> add
+scratch/main> todo
+```
+
+```ucm:hide
+scratch/main> delete.project scratch
 ```
diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md
index cfad74ec1..07f0b03c3 100644
--- a/unison-src/transcripts/todo.output.md
+++ b/unison-src/transcripts/todo.output.md
@@ -3,15 +3,11 @@
 When there's nothing to do, `todo` says this:
 
 ```ucm
-project/main> todo
+scratch/main> todo
 
   You have no pending todo items. Good work! ✅
 
 ```
-# Conflicted names
-
-The todo command shows conflicted names (not demonstrated here yet because it is not easy to create them for tests, yet).
-
 # Dependents of `todo`
 
 The `todo` command shows local (outside `lib`) terms that directly call `todo`.
@@ -39,14 +35,14 @@ bar = foo + foo
 
 ```
 ```ucm
-project/main> add
+scratch/main> add
 
   ⍟ I've added these definitions:
   
     bar : Nat
     foo : Nat
 
-project/main> todo
+scratch/main> todo
 
   These terms call `todo`:
   
@@ -78,14 +74,14 @@ baz = foo.bar + foo.bar
 
 ```
 ```ucm
-project/main> add
+scratch/main> add
 
   ⍟ I've added these definitions:
   
     baz     : Nat
     foo.bar : Nat
 
-project/main> delete.namespace.force foo
+scratch/main> delete.namespace.force foo
 
   Done.
 
@@ -97,10 +93,91 @@ project/main> delete.namespace.force foo
   Dependency   Referenced In
   bar          1. baz
 
-project/main> todo
+scratch/main> todo
 
   These terms do not have any names in the current namespace:
   
     1. #1jujb8oelv
 
 ```
+# Conflicted names
+
+The `todo` command shows conflicted names.
+
+```unison
+foo = 16
+bar = 17
+```
+
+```ucm
+
+  Loading changes detected in scratch.u.
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      bar : Nat
+      foo : Nat
+
+```
+```ucm
+scratch/main> add
+
+  ⍟ I've added these definitions:
+  
+    bar : Nat
+    foo : Nat
+
+scratch/main> debug.alias.term.force foo bar
+
+  Done.
+
+scratch/main> todo
+
+  ❓
+  
+  The term bar has conflicting definitions: 1. foo 2.
+  bar#cq22mm4sca
+  
+  Tip: Use `move.term` or `delete.term` to resolve the
+       conflicts.
+
+```
+# Definitions in lib
+
+The `todo` command complains about terms and types directly in `lib`.
+
+```unison
+lib.foo = 16
+```
+
+```ucm
+
+  Loading changes detected in scratch.u.
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      lib.foo : Nat
+
+```
+```ucm
+scratch/main> add
+
+  ⍟ I've added these definitions:
+  
+    lib.foo : Nat
+
+scratch/main> todo
+
+  There's a type or term at the top level of the `lib`
+  namespace, where I only expect to find subnamespaces
+  representing library dependencies. Please move or remove it.
+
+```

From 50f28817e57fdcafeb3cca906f021ccd7055c0d6 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Tue, 2 Jul 2024 13:06:03 -0400
Subject: [PATCH 2/9] add Names.lenientToNametree

---
 .../src/Unison/Util/BiMultimap.hs             |  1 +
 .../src/Unison/Codebase/Branch.hs             |  3 +-
 unison-core/package.yaml                      |  1 +
 unison-core/src/Unison/Names.hs               | 74 ++++++++++++++-----
 unison-core/unison-core1.cabal                |  2 +
 5 files changed, 59 insertions(+), 22 deletions(-)

diff --git a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs
index 9167d6e6b..e970281f0 100644
--- a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs
+++ b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs
@@ -178,6 +178,7 @@ invertDomain =
     g x acc y =
       Map.insert y x acc
 
+-- | Construct a left-unique relation from a mapping from its right-elements to its left-elements.
 fromRange :: (Ord a, Ord b) => Map b a -> BiMultimap a b
 fromRange m =
   BiMultimap (Map.foldlWithKey' f Map.empty m) m
diff --git a/parser-typechecker/src/Unison/Codebase/Branch.hs b/parser-typechecker/src/Unison/Codebase/Branch.hs
index 68c55c88f..00e2f7690 100644
--- a/parser-typechecker/src/Unison/Codebase/Branch.hs
+++ b/parser-typechecker/src/Unison/Codebase/Branch.hs
@@ -139,6 +139,7 @@ import Unison.NameSegment (NameSegment)
 import Unison.NameSegment qualified as NameSegment
 import Unison.Prelude hiding (empty)
 import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId)
+import Unison.Reference qualified as Reference
 import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent
 import Unison.Util.List qualified as List
@@ -148,7 +149,6 @@ import Unison.Util.Set qualified as Set
 import Unison.Util.Star2 qualified as Star2
 import Witherable (FilterableWithIndex (imapMaybe))
 import Prelude hiding (head, read, subtract)
-import qualified Unison.Reference as Reference
 
 instance AsEmpty (Branch m) where
   _Empty = prism' (const empty) matchEmpty
@@ -215,7 +215,6 @@ deepTypeReferenceIds :: Branch0 m -> Set TypeReferenceId
 deepTypeReferenceIds =
   Set.mapMaybe Reference.toId . deepTypeReferences
 
-
 namespaceStats :: Branch0 m -> NamespaceStats
 namespaceStats b =
   NamespaceStats
diff --git a/unison-core/package.yaml b/unison-core/package.yaml
index fb5b62b73..2b8bea50b 100644
--- a/unison-core/package.yaml
+++ b/unison-core/package.yaml
@@ -66,6 +66,7 @@ default-extensions:
   - DerivingStrategies
   - DerivingVia
   - DoAndIfThenElse
+  - DuplicateRecordFields
   - FlexibleContexts
   - FlexibleInstances
   - GADTs
diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs
index b21b76192..1897ac117 100644
--- a/unison-core/src/Unison/Names.hs
+++ b/unison-core/src/Unison/Names.hs
@@ -49,12 +49,15 @@ module Unison.Names
     hashQualifyTypesRelation,
     hashQualifyTermsRelation,
     fromTermsAndTypes,
+    lenientToNametree,
   )
 where
 
 import Data.Map qualified as Map
+import Data.Semialign (alignWith)
 import Data.Set qualified as Set
 import Data.Text qualified as Text
+import Data.These (These (..))
 import Text.FuzzyFind qualified as FZF
 import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.ConstructorType qualified as CT
@@ -64,6 +67,7 @@ import Unison.LabeledDependency (LabeledDependency)
 import Unison.LabeledDependency qualified as LD
 import Unison.Name (Name)
 import Unison.Name qualified as Name
+import Unison.NameSegment (NameSegment)
 import Unison.Prelude
 import Unison.Reference (Reference, TermReference, TypeReference)
 import Unison.Reference qualified as Reference
@@ -71,6 +75,10 @@ import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent
 import Unison.ShortHash (ShortHash)
 import Unison.ShortHash qualified as SH
+import Unison.Util.BiMultimap (BiMultimap)
+import Unison.Util.BiMultimap qualified as BiMultimap
+import Unison.Util.Defns (Defns (..), DefnsF)
+import Unison.Util.Nametree (Nametree, unflattenNametree)
 import Unison.Util.Relation (Relation)
 import Unison.Util.Relation qualified as R
 import Unison.Util.Relation qualified as Relation
@@ -95,7 +103,7 @@ instance Monoid (Names) where
   mempty = Names mempty mempty
 
 isEmpty :: Names -> Bool
-isEmpty n = R.null (terms n) && R.null (types n)
+isEmpty n = R.null n.terms && R.null n.types
 
 map :: (Name -> Name) -> Names -> Names
 map f (Names {terms, types}) = Names terms' types'
@@ -122,8 +130,8 @@ fuzzyFind nameToText query names =
     . Prelude.filter prefilter
     . Map.toList
     -- `mapMonotonic` is safe here and saves a log n factor
-    $ (Set.mapMonotonic Left <$> R.toMultimap (terms names))
-      <> (Set.mapMonotonic Right <$> R.toMultimap (types names))
+    $ (Set.mapMonotonic Left <$> R.toMultimap names.terms)
+      <> (Set.mapMonotonic Right <$> R.toMultimap names.types)
   where
     lowerqueryt = Text.toLower . Text.pack <$> query
     -- For performance, case-insensitive substring matching as a pre-filter
@@ -250,8 +258,8 @@ unionLeft' ::
   Names
 unionLeft' shouldOmit a b = Names terms' types'
   where
-    terms' = foldl' go (terms a) (R.toList $ terms b)
-    types' = foldl' go (types a) (R.toList $ types b)
+    terms' = foldl' go a.terms (R.toList b.terms)
+    types' = foldl' go a.types (R.toList b.types)
     go :: (Ord a, Ord b) => Relation a b -> (a, b) -> Relation a b
     go acc (n, r) = if shouldOmit n r acc then acc else R.insert n r acc
 
@@ -260,7 +268,7 @@ numHashChars :: Int
 numHashChars = 3
 
 termsNamed :: Names -> Name -> Set Referent
-termsNamed = flip R.lookupDom . terms
+termsNamed = flip R.lookupDom . (.terms)
 
 -- | Get all terms with a specific name.
 refTermsNamed :: Names -> Name -> Set TermReference
@@ -281,13 +289,13 @@ refTermsHQNamed names = \case
      in Set.mapMaybe f (termsNamed names name)
 
 typesNamed :: Names -> Name -> Set TypeReference
-typesNamed = flip R.lookupDom . types
+typesNamed = flip R.lookupDom . (.types)
 
 namesForReferent :: Names -> Referent -> Set Name
-namesForReferent names r = R.lookupRan r (terms names)
+namesForReferent names r = R.lookupRan r names.terms
 
 namesForReference :: Names -> TypeReference -> Set Name
-namesForReference names r = R.lookupRan r (types names)
+namesForReference names r = R.lookupRan r names.types
 
 termAliases :: Names -> Name -> Referent -> Set Name
 termAliases names n r = Set.delete n $ namesForReferent names r
@@ -422,20 +430,20 @@ filterTypes f (Names terms types) = Names terms (R.filterDom f types)
 difference :: Names -> Names -> Names
 difference a b =
   Names
-    (R.difference (terms a) (terms b))
-    (R.difference (types a) (types b))
+    (R.difference a.terms b.terms)
+    (R.difference a.types b.types)
 
 contains :: Names -> Reference -> Bool
 contains names =
   -- We want to compute `termsReferences` only once, if `contains` is partially applied to a `Names`, and called over
   -- and over for different references. GHC would probably float `termsReferences` out without the explicit lambda, but
   -- it's written like this just to be sure.
-  \r -> Set.member r termsReferences || R.memberRan r (types names)
+  \r -> Set.member r termsReferences || R.memberRan r names.types
   where
     -- this check makes `contains` O(n) instead of O(log n)
     termsReferences :: Set TermReference
     termsReferences =
-      Set.map Referent.toReference (R.ran (terms names))
+      Set.map Referent.toReference (R.ran names.terms)
 
 -- | filters out everything from the domain except what's conflicted
 conflicts :: Names -> Names
@@ -448,9 +456,9 @@ conflicts Names {..} = Names (R.filterManyDom terms) (R.filterManyDom types)
 -- See usage in `FileParser` for handling precendence of symbol
 -- resolution where local names are preferred to codebase names.
 shadowTerms :: [Name] -> Names -> Names
-shadowTerms ns n0 = Names terms' (types n0)
+shadowTerms ns n0 = Names terms' n0.types
   where
-    terms' = foldl' go (terms n0) ns
+    terms' = foldl' go n0.terms ns
     go ts name = R.deleteDom name ts
 
 -- | Given a mapping from name to qualified name, update a `Names`,
@@ -461,8 +469,8 @@ shadowTerms ns n0 = Names terms' (types n0)
 importing :: [(Name, Name)] -> Names -> Names
 importing shortToLongName ns =
   Names
-    (foldl' go (terms ns) shortToLongName)
-    (foldl' go (types ns) shortToLongName)
+    (foldl' go ns.terms shortToLongName)
+    (foldl' go ns.types shortToLongName)
   where
     go :: (Ord r) => Relation Name r -> (Name, Name) -> Relation Name r
     go m (shortname, qname) = case Name.searchByRankedSuffix qname m of
@@ -476,8 +484,8 @@ importing shortToLongName ns =
 -- `[(foo, io.foo), (bar, io.bar)]`.
 expandWildcardImport :: Name -> Names -> [(Name, Name)]
 expandWildcardImport prefix ns =
-  [(suffix, full) | Just (suffix, full) <- go <$> R.toList (terms ns)]
-    <> [(suffix, full) | Just (suffix, full) <- go <$> R.toList (types ns)]
+  [(suffix, full) | Just (suffix, full) <- go <$> R.toList ns.terms]
+    <> [(suffix, full) | Just (suffix, full) <- go <$> R.toList ns.types]
   where
     go :: (Name, a) -> Maybe (Name, Name)
     go (full, _) = do
@@ -498,7 +506,7 @@ constructorsForType r ns =
       possibleDatas = [Referent.Con (ConstructorReference r cid) CT.Data | cid <- [0 ..]]
       possibleEffects = [Referent.Con (ConstructorReference r cid) CT.Effect | cid <- [0 ..]]
       trim [] = []
-      trim (h : t) = case R.lookupRan h (terms ns) of
+      trim (h : t) = case R.lookupRan h ns.terms of
         s
           | Set.null s -> []
           | otherwise -> [(n, h) | n <- toList s] ++ trim t
@@ -517,3 +525,29 @@ hashQualifyRelation fromNamedRef rel = R.map go rel
       if Set.size (R.lookupDom n rel) > 1
         then (HQ.take numHashChars $ fromNamedRef n r, r)
         else (HQ.NameOnly n, r)
+
+-- | "Leniently" view a Names as a NameTree
+--
+-- This function is "lenient" in the sense that it does not handle conflicted names with any smarts whatsoever. The
+-- resulting nametree will simply contain one of the associated references of a conflicted name - we don't specify
+-- which.
+lenientToNametree :: Names -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
+lenientToNametree names =
+  alignWith
+    ( \case
+        This terms -> Defns {terms, types = Map.empty}
+        That types -> Defns {terms = Map.empty, types}
+        These terms types -> Defns {terms, types}
+    )
+    (lenientRelationToNametree names.terms)
+    (lenientRelationToNametree names.types)
+  where
+    lenientRelationToNametree :: Ord a => Relation Name a -> Nametree (Map NameSegment a)
+    lenientRelationToNametree =
+      unflattenNametree . lenientRelationToLeftUniqueRelation
+
+    lenientRelationToLeftUniqueRelation :: (Ord a, Ord b) => Relation a b -> BiMultimap b a
+    lenientRelationToLeftUniqueRelation =
+      -- The partial `Set.findMin` are fine here because Relation.domain only has non-empty Set values. A NESet would be
+      -- better.
+      BiMultimap.fromRange . Map.map Set.findMin . Relation.domain
diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal
index f40185f4d..bde4b2a6f 100644
--- a/unison-core/unison-core1.cabal
+++ b/unison-core/unison-core1.cabal
@@ -72,6 +72,7 @@ library
       DerivingStrategies
       DerivingVia
       DoAndIfThenElse
+      DuplicateRecordFields
       FlexibleContexts
       FlexibleInstances
       GADTs
@@ -140,6 +141,7 @@ test-suite tests
       DerivingStrategies
       DerivingVia
       DoAndIfThenElse
+      DuplicateRecordFields
       FlexibleContexts
       FlexibleInstances
       GADTs

From fdf91bbce67e17a33220a67f02a0e81aba6be170 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Tue, 2 Jul 2024 17:44:09 -0400
Subject: [PATCH 3/9] make decl coherency check more abstract to support "get
 all violations" use case

---
 .../src/Unison/Merge/DeclCoherencyCheck.hs    | 190 +++++++++++-------
 1 file changed, 122 insertions(+), 68 deletions(-)

diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs
index 2a75252fc..907c453e2 100644
--- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs
+++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs
@@ -87,11 +87,9 @@ module Unison.Merge.DeclCoherencyCheck
 where
 
 import Control.Lens ((%=), (.=), _2)
-import Control.Monad.Except (ExceptT)
 import Control.Monad.Except qualified as Except
 import Control.Monad.State.Strict (StateT)
 import Control.Monad.State.Strict qualified as State
-import Control.Monad.Trans.Except qualified as Except (except)
 import Data.Functor.Compose (Compose (..))
 import Data.IntMap.Strict (IntMap)
 import Data.IntMap.Strict qualified as IntMap
@@ -136,87 +134,143 @@ checkDeclCoherency ::
   (TypeReferenceId -> m Int) ->
   Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
   m (Either IncoherentDeclReason DeclNameLookup)
-checkDeclCoherency loadDeclNumConstructors =
+checkDeclCoherency loadDeclNumConstructors nametree =
   Except.runExceptT
-    . fmap (view #declNameLookup)
+    ( checkDeclCoherencyWith
+        (lift . loadDeclNumConstructors)
+        OnIncoherentDeclReasons
+          { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), -- :: Name -> Name -> Name -> m (),
+            onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), -- :: Name -> m (),
+            onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), -- :: Name -> Name -> m (),
+            onStrayConstructor = \x -> Except.throwError (IncoherentDeclReason'StrayConstructor x) -- :: Name -> m ()
+          }
+        nametree
+    )
+
+data OnIncoherentDeclReasons m = OnIncoherentDeclReasons
+  { onConstructorAlias :: Name -> Name -> Name -> m (),
+    onMissingConstructorName :: Name -> m (),
+    onNestedDeclAlias :: Name -> Name -> m (),
+    onStrayConstructor :: Name -> m ()
+  }
+
+checkDeclCoherencyWith ::
+  forall m.
+  Monad m =>
+  (TypeReferenceId -> m Int) ->
+  OnIncoherentDeclReasons m ->
+  Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
+  m DeclNameLookup
+checkDeclCoherencyWith loadDeclNumConstructors callbacks =
+  fmap (view #declNameLookup)
     . (`State.execStateT` DeclCoherencyCheckState Map.empty (DeclNameLookup Map.empty Map.empty))
     . go []
   where
     go ::
       [NameSegment] ->
       (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
-      StateT DeclCoherencyCheckState (ExceptT IncoherentDeclReason m) ()
+      StateT DeclCoherencyCheckState m ()
     go prefix (Nametree defns children) = do
-      for_ (Map.toList defns.terms) \case
-        (_, Referent.Ref _) -> pure ()
-        (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure ()
-        (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do
-          DeclCoherencyCheckState {expectedConstructors} <- State.get
-          expectedConstructors1 <- lift (Except.except (Map.upsertF f typeRef expectedConstructors))
-          #expectedConstructors .= expectedConstructors1
-          where
-            f ::
-              Maybe (Name, ConstructorNames) ->
-              Either IncoherentDeclReason (Name, ConstructorNames)
-            f = \case
-              Nothing -> Left (IncoherentDeclReason'StrayConstructor name1)
-              Just (typeName, expected) ->
-                case recordConstructorName conId name1 expected of
-                  Left existingName -> Left (IncoherentDeclReason'ConstructorAlias typeName existingName name1)
-                  Right expected1 -> Right (typeName, expected1)
-              where
-                name1 = fullName name
-
+      for_ (Map.toList defns.terms) (checkDeclCoherency_terms callbacks prefix)
       childrenWeWentInto <-
-        forMaybe (Map.toList defns.types) \case
-          (_, ReferenceBuiltin _) -> pure Nothing
-          (name, ReferenceDerived typeRef) -> do
-            DeclCoherencyCheckState {expectedConstructors} <- State.get
-            whatHappened <- do
-              let recordNewDecl ::
-                    Maybe (Name, ConstructorNames) ->
-                    Compose (ExceptT IncoherentDeclReason m) WhatHappened (Name, ConstructorNames)
-                  recordNewDecl =
-                    Compose . \case
-                      Just (shorterTypeName, _) -> Except.throwError (IncoherentDeclReason'NestedDeclAlias shorterTypeName typeName)
-                      Nothing ->
-                        lift (loadDeclNumConstructors typeRef) <&> \case
-                          0 -> UninhabitedDecl
-                          n -> InhabitedDecl (typeName, emptyConstructorNames n)
-              lift (getCompose (Map.upsertF recordNewDecl typeRef expectedConstructors))
-            case whatHappened of
-              UninhabitedDecl -> do
-                #declNameLookup . #declToConstructors %= Map.insert typeName []
-                pure Nothing
-              InhabitedDecl expectedConstructors1 -> do
-                child <-
-                  Map.lookup name children & onNothing do
-                    Except.throwError (IncoherentDeclReason'MissingConstructorName typeName)
-                #expectedConstructors .= expectedConstructors1
-                go (name : prefix) child
-                DeclCoherencyCheckState {expectedConstructors} <- State.get
-                -- fromJust is safe here because we upserted `typeRef` key above
-                let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) =
-                      Map.deleteLookup typeRef expectedConstructors
-                constructorNames <-
-                  sequence (IntMap.elems maybeConstructorNames) & onNothing do
-                    Except.throwError (IncoherentDeclReason'MissingConstructorName typeName)
-                #expectedConstructors .= expectedConstructors1
+        forMaybe
+          (Map.toList defns.types)
+          (checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children)
+      let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto
+      for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child
+
+checkDeclCoherency_terms ::
+  forall m.
+  Monad m =>
+  OnIncoherentDeclReasons m ->
+  [NameSegment] ->
+  (NameSegment, Referent) ->
+  StateT DeclCoherencyCheckState m ()
+checkDeclCoherency_terms callbacks prefix = \case
+  (_, Referent.Ref _) -> pure ()
+  (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure ()
+  (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do
+    state <- State.get
+    whenJustM (lift (runMaybeT (Map.upsertF f typeRef state.expectedConstructors))) \expectedConstructors1 ->
+      #expectedConstructors .= expectedConstructors1
+    where
+      f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames)
+      f = \case
+        Nothing -> do
+          lift (callbacks.onStrayConstructor name1)
+          MaybeT (pure Nothing)
+        Just (typeName, expected) ->
+          case recordConstructorName conId name1 expected of
+            Left existingName -> do
+              lift (callbacks.onConstructorAlias typeName existingName name1)
+              MaybeT (pure Nothing)
+            Right expected1 -> pure (typeName, expected1)
+        where
+          name1 =
+            Name.fromReverseSegments (name :| prefix)
+
+checkDeclCoherency_types ::
+  forall m.
+  Monad m =>
+  (TypeReferenceId -> m Int) ->
+  OnIncoherentDeclReasons m ->
+  ( [NameSegment] ->
+    (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
+    StateT DeclCoherencyCheckState m ()
+  ) ->
+  [NameSegment] ->
+  Map NameSegment (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) ->
+  (NameSegment, TypeReference) ->
+  StateT DeclCoherencyCheckState m (Maybe NameSegment)
+checkDeclCoherency_types loadDeclNumConstructors callbacks go prefix children = \case
+  (_, ReferenceBuiltin _) -> pure Nothing
+  (name, ReferenceDerived typeRef) -> do
+    state <- State.get
+    maybeWhatHappened <- do
+      let recordNewDecl ::
+            Maybe (Name, ConstructorNames) ->
+            Compose (MaybeT m) WhatHappened (Name, ConstructorNames)
+          recordNewDecl =
+            Compose . \case
+              Just (shorterTypeName, _) -> do
+                lift (callbacks.onNestedDeclAlias shorterTypeName typeName)
+                MaybeT (pure Nothing)
+              Nothing ->
+                lift (loadDeclNumConstructors typeRef) <&> \case
+                  0 -> UninhabitedDecl
+                  n -> InhabitedDecl (typeName, emptyConstructorNames n)
+      lift (runMaybeT (getCompose (Map.upsertF recordNewDecl typeRef state.expectedConstructors)))
+    case maybeWhatHappened of
+      Nothing -> pure Nothing
+      Just UninhabitedDecl -> do
+        #declNameLookup . #declToConstructors %= Map.insert typeName []
+        pure Nothing
+      Just (InhabitedDecl expectedConstructors1) -> do
+        case Map.lookup name children of
+          Nothing -> do
+            lift (callbacks.onMissingConstructorName typeName)
+            pure Nothing
+          Just child -> do
+            #expectedConstructors .= expectedConstructors1
+            go (name : prefix) child
+            state <- State.get
+            -- fromJust is safe here because we upserted `typeRef` key above
+            let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) =
+                  Map.deleteLookup typeRef state.expectedConstructors
+            #expectedConstructors .= expectedConstructors1
+            case sequence (IntMap.elems maybeConstructorNames) of
+              Nothing -> lift (callbacks.onMissingConstructorName typeName)
+              Just constructorNames -> do
                 #declNameLookup . #constructorToDecl %= \constructorToDecl ->
                   List.foldl'
                     (\acc constructorName -> Map.insert constructorName typeName acc)
                     constructorToDecl
                     constructorNames
                 #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames
-                pure (Just name)
-            where
-              typeName = fullName name
-
-      let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto
-      for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child
-      where
-        fullName name =
-          Name.fromReverseSegments (name :| prefix)
+            pure (Just name)
+    where
+      typeName =
+        Name.fromReverseSegments (name :| prefix)
 
 -- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup,
 -- which doesn't require a name for every constructor, and allows a constructor with a nameless decl.

From 06b731b7749c5a1aa8223d2fd15bbe13a68ebd5b Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Wed, 3 Jul 2024 11:19:18 -0400
Subject: [PATCH 4/9] report constructor aliases in `todo`

---
 .../Codebase/Editor/HandleInput/Todo.hs       | 17 +++--
 .../src/Unison/Codebase/Editor/Output.hs      |  5 +-
 .../src/Unison/CommandLine/OutputMessages.hs  | 31 ++++++++-
 .../src/Unison/Merge/DeclCoherencyCheck.hs    | 63 +++++++++++++++++--
 unison-src/transcripts/todo.md                | 22 +++++++
 unison-src/transcripts/todo.output.md         | 41 ++++++++++++
 6 files changed, 167 insertions(+), 12 deletions(-)

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

From 052fd5194817140b8525d1e6f4c145b1afec937f Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Wed, 3 Jul 2024 11:38:33 -0400
Subject: [PATCH 5/9] report missing constructor names in `todo`

---
 .../src/Unison/CommandLine/OutputMessages.hs  | 32 +++++++++++----
 unison-src/transcripts/todo.md                | 22 +++++++++++
 unison-src/transcripts/todo.output.md         | 39 +++++++++++++++++++
 3 files changed, 86 insertions(+), 7 deletions(-)

diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index 470d6f88a..0095974c1 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -1402,11 +1402,11 @@ notifyUser dir = \case
               <> "the same on both branches, or making neither of them a builtin, and then try the merge again."
           )
       ]
+  -- Note [ConstructorAliasMessage] If you change this, also change the other similar one
   MergeConstructorAlias aliceOrBob typeName conName1 conName2 ->
     pure . P.lines $
       [ P.wrap "Sorry, I wasn't able to perform the merge:",
         "",
-        -- Note [ConstructorAliasMessage] If you change this, also change the other similar one
         P.wrap $
           "On"
             <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
@@ -1418,6 +1418,7 @@ notifyUser dir = \case
         "",
         P.wrap "Please delete all but one name for each constructor, and then try merging again."
       ]
+  -- Note [DefnsInLibMessage] If you change this, also change the other similar one
   MergeDefnsInLib aliceOrBob ->
     pure . P.lines $
       [ P.wrap "Sorry, I wasn't able to perform the merge:",
@@ -1425,12 +1426,12 @@ notifyUser dir = \case
         P.wrap $
           "On"
             <> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
-            -- Note [DefnsInLibMessage] If you change this, also change the other similar one
             <> "there's a type or term at the top level of the `lib` namespace, where I only expect to find"
             <> "subnamespaces representing library dependencies.",
         "",
         P.wrap "Please move or remove it and then try merging again."
       ]
+  -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one
   MergeMissingConstructorName aliceOrBob name ->
     pure . P.lines $
       [ P.wrap "Sorry, I wasn't able to perform the merge:",
@@ -2731,11 +2732,11 @@ handleTodoOutput todo
               else mempty
 
       prettyConstructorAliases <-
-        if null todo.incoherentDeclReasons.constructorAliases
-          then pure mempty
-          else do
+        case todo.incoherentDeclReasons.constructorAliases of
+          [] -> pure mempty
+          aliases -> do
             things <-
-              for todo.incoherentDeclReasons.constructorAliases \(typeName, conName1, conName2) -> do
+              for aliases \(typeName, conName1, conName2) -> do
                 n1 <- addNumberedArg (SA.Name conName1)
                 n2 <- addNumberedArg (SA.Name conName2)
                 pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2)
@@ -2756,13 +2757,30 @@ handleTodoOutput todo
                   )
                 & P.sep "\n\n"
 
+      prettyMissingConstructorNames <-
+        case todo.incoherentDeclReasons.missingConstructorNames of
+          [] -> pure mempty
+          types0 -> do
+            types1 <-
+              for types0 \typ -> do
+                n <- addNumberedArg (SA.Name typ)
+                pure (formatNum n <> prettyName typ)
+            -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one
+            pure $
+              P.wrap
+                "These types have some constructors with missing names:"
+                <> P.newline
+                <> P.newline
+                <> P.indentN 2 (P.lines types1)
+
       (pure . P.sep "\n\n" . P.nonEmpty)
         [ prettyDependentsOfTodo,
           prettyDirectTermDependenciesWithoutNames,
           prettyDirectTypeDependenciesWithoutNames,
           prettyConflicts,
           prettyDefnsInLib,
-          prettyConstructorAliases
+          prettyConstructorAliases,
+          prettyMissingConstructorNames
         ]
 
 listOfDefinitions ::
diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md
index 5b4a40dec..20ed37146 100644
--- a/unison-src/transcripts/todo.md
+++ b/unison-src/transcripts/todo.md
@@ -120,3 +120,25 @@ scratch/main> todo
 ```ucm:hide
 scratch/main> delete.project scratch
 ```
+
+# Missing constructor names
+
+The `todo` command complains about missing constructor names.
+
+```ucm:hide
+scratch/main> builtins.mergeio lib.builtins
+```
+
+```unison
+type Foo = Bar
+```
+
+```ucm
+scratch/main> add
+scratch/main> delete.term Foo.Bar
+scratch/main> todo
+```
+
+```ucm:hide
+scratch/main> delete.project scratch
+```
diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md
index 0de57bd2c..0e8e23332 100644
--- a/unison-src/transcripts/todo.output.md
+++ b/unison-src/transcripts/todo.output.md
@@ -222,3 +222,42 @@ scratch/main> todo
     2. Foo.Two
 
 ```
+# Missing constructor names
+
+The `todo` command complains about missing constructor names.
+
+```unison
+type Foo = Bar
+```
+
+```ucm
+
+  Loading changes detected in scratch.u.
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      type Foo
+
+```
+```ucm
+scratch/main> add
+
+  ⍟ I've added these definitions:
+  
+    type Foo
+
+scratch/main> delete.term Foo.Bar
+
+  Done.
+
+scratch/main> todo
+
+  These types have some constructors with missing names:
+  
+    1. Foo
+
+```

From 1857640da47272948bbe8b5eda2589b4cf6ba4d1 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Wed, 3 Jul 2024 11:53:45 -0400
Subject: [PATCH 6/9] report nested decl aliases in `todo`

---
 .../src/Unison/CommandLine/OutputMessages.hs  | 94 ++++++++++++++-----
 unison-src/transcripts/todo.md                | 22 +++++
 unison-src/transcripts/todo.output.md         | 40 ++++++++
 3 files changed, 131 insertions(+), 25 deletions(-)

diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index 0095974c1..0e315216d 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -1450,6 +1450,7 @@ notifyUser dir = \case
             <> IP.makeExample IP.aliasTerm ["<hash>", prettyName name <> ".<ConstructorName>"]
             <> "to give names to each unnamed constructor, and then try the merge again."
       ]
+  -- Note [NestedDeclAliasMessage] If you change this, also change the other similar one
   MergeNestedDeclAlias aliceOrBob shorterName longerName ->
     pure . P.wrap $
       "On"
@@ -2732,30 +2733,48 @@ handleTodoOutput todo
               else mempty
 
       prettyConstructorAliases <-
-        case todo.incoherentDeclReasons.constructorAliases of
-          [] -> pure mempty
-          aliases -> do
-            things <-
-              for aliases \(typeName, conName1, conName2) -> do
-                n1 <- addNumberedArg (SA.Name conName1)
-                n2 <- addNumberedArg (SA.Name conName2)
-                pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2)
-            pure $
-              things
-                & map
-                  ( \(typeName, prettyCon1, prettyCon2) ->
-                      -- Note [ConstructorAliasMessage] If you change this, also change the other similar one
-                      P.wrap
-                        ( "The type"
-                            <> prettyName typeName
-                            <> "has a constructor with multiple names. Please delete all but one name for each"
-                            <> "constructor."
-                        )
-                        <> P.newline
-                        <> P.newline
-                        <> P.indentN 2 (P.lines [prettyCon1, prettyCon2])
-                  )
-                & P.sep "\n\n"
+        let -- We want to filter out constructor aliases whose types are part of a "nested decl alias" problem, because
+            -- otherwise we'd essentially be reporting those issues twice.
+            --
+            -- That is, if we have two nested aliases like
+            --
+            --   Foo = #XYZ
+            --   Foo.Bar = #XYZ#0
+            --
+            --   Foo.inner.Alias = #XYZ
+            --   Foo.inner.Alias.Constructor = #XYZ#0
+            --
+            -- then we'd prefer to say "oh no Foo and Foo.inner.Alias are aliases" but *not* additionally say "oh no
+            -- Foo.Bar and Foo.inner.Alias.Constructor are aliases".
+            notNestedDeclAlias (typeName, _, _) =
+              foldr
+                (\(short, long) acc -> typeName /= short && typeName /= long && acc)
+                True
+                todo.incoherentDeclReasons.nestedDeclAliases
+         in case filter notNestedDeclAlias todo.incoherentDeclReasons.constructorAliases of
+              [] -> pure mempty
+              aliases -> do
+                things <-
+                  for aliases \(typeName, conName1, conName2) -> do
+                    n1 <- addNumberedArg (SA.Name conName1)
+                    n2 <- addNumberedArg (SA.Name conName2)
+                    pure (typeName, formatNum n1 <> prettyName conName1, formatNum n2 <> prettyName conName2)
+                pure $
+                  things
+                    & map
+                      ( \(typeName, prettyCon1, prettyCon2) ->
+                          -- Note [ConstructorAliasMessage] If you change this, also change the other similar one
+                          P.wrap
+                            ( "The type"
+                                <> prettyName typeName
+                                <> "has a constructor with multiple names. Please delete all but one name for each"
+                                <> "constructor."
+                            )
+                            <> P.newline
+                            <> P.newline
+                            <> P.indentN 2 (P.lines [prettyCon1, prettyCon2])
+                      )
+                    & P.sep "\n\n"
 
       prettyMissingConstructorNames <-
         case todo.incoherentDeclReasons.missingConstructorNames of
@@ -2773,6 +2792,30 @@ handleTodoOutput todo
                 <> P.newline
                 <> P.indentN 2 (P.lines types1)
 
+      prettyNestedDeclAliases <-
+        case todo.incoherentDeclReasons.nestedDeclAliases of
+          [] -> pure mempty
+          aliases0 -> do
+            aliases1 <-
+              for aliases0 \(short, long) -> do
+                n1 <- addNumberedArg (SA.Name short)
+                n2 <- addNumberedArg (SA.Name long)
+                pure (formatNum n1 <> prettyName short, formatNum n2 <> prettyName long)
+            -- Note [NestedDeclAliasMessage] If you change this, also change the other similar one
+            pure $
+              aliases1
+                & map
+                  ( \(short, long) ->
+                      P.wrap
+                        ( "These types are aliases, but one is nested under the other. Please separate them or delete"
+                            <> "one copy."
+                        )
+                        <> P.newline
+                        <> P.newline
+                        <> P.indentN 2 (P.lines [short, long])
+                  )
+                & P.sep "\n\n"
+
       (pure . P.sep "\n\n" . P.nonEmpty)
         [ prettyDependentsOfTodo,
           prettyDirectTermDependenciesWithoutNames,
@@ -2780,7 +2823,8 @@ handleTodoOutput todo
           prettyConflicts,
           prettyDefnsInLib,
           prettyConstructorAliases,
-          prettyMissingConstructorNames
+          prettyMissingConstructorNames,
+          prettyNestedDeclAliases
         ]
 
 listOfDefinitions ::
diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md
index 20ed37146..d3cf81166 100644
--- a/unison-src/transcripts/todo.md
+++ b/unison-src/transcripts/todo.md
@@ -142,3 +142,25 @@ scratch/main> todo
 ```ucm:hide
 scratch/main> delete.project scratch
 ```
+
+# Nested decl aliases
+
+The `todo` command complains about nested decl aliases.
+
+```ucm:hide
+scratch/main> builtins.mergeio lib.builtins
+```
+
+```unison
+structural type Foo a = One a | Two a a
+structural type Foo.inner.Bar a = Uno a | Dos a a
+```
+
+```ucm
+scratch/main> add
+scratch/main> todo
+```
+
+```ucm:hide
+scratch/main> delete.project scratch
+```
diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md
index 0e8e23332..32b35c50b 100644
--- a/unison-src/transcripts/todo.output.md
+++ b/unison-src/transcripts/todo.output.md
@@ -261,3 +261,43 @@ scratch/main> todo
     1. Foo
 
 ```
+# Nested decl aliases
+
+The `todo` command complains about nested decl aliases.
+
+```unison
+structural type Foo a = One a | Two a a
+structural type Foo.inner.Bar a = Uno a | Dos a a
+```
+
+```ucm
+
+  Loading changes detected in scratch.u.
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      structural type Foo a
+      structural type Foo.inner.Bar a
+
+```
+```ucm
+scratch/main> add
+
+  ⍟ I've added these definitions:
+  
+    structural type Foo a
+    structural type Foo.inner.Bar a
+
+scratch/main> todo
+
+  These types are aliases, but one is nested under the other.
+  Please separate them or delete one copy.
+  
+    1. Foo
+    2. Foo.inner.Bar
+
+```

From 05d34024bd219b6870f4bc394954e330a7971f20 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Wed, 3 Jul 2024 11:59:17 -0400
Subject: [PATCH 7/9] report stray constructors in `todo`

---
 .../src/Unison/CommandLine/OutputMessages.hs  | 30 ++++++++++--
 unison-src/transcripts/todo.md                | 22 +++++++++
 unison-src/transcripts/todo.output.md         | 46 +++++++++++++++++--
 3 files changed, 90 insertions(+), 8 deletions(-)

diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index 0e315216d..d2684f190 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -1461,6 +1461,7 @@ notifyUser dir = \case
         <> P.group (prettyName shorterName <> ".")
         <> "I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or"
         <> "delete one copy, and then try merging again."
+  -- Note [StrayConstructorMessage] If you change this, also change the other similar one
   MergeStrayConstructor aliceOrBob name ->
     pure . P.lines $
       [ P.wrap $
@@ -2685,7 +2686,7 @@ handleTodoOutput todo
                         & P.syntaxToColor
                 pure (formatNum n <> name)
             pure $
-              P.wrap "These terms call `todo`:"
+              P.wrap "These terms call `todo`."
                 <> P.newline
                 <> P.newline
                 <> P.indentN 2 (P.lines terms)
@@ -2699,7 +2700,7 @@ handleTodoOutput todo
                 n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term)))
                 pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term))
             pure $
-              P.wrap "These terms do not have any names in the current namespace:"
+              P.wrap "These terms do not have any names in the current namespace."
                 <> P.newline
                 <> P.newline
                 <> P.indentN 2 (P.lines terms)
@@ -2713,7 +2714,7 @@ handleTodoOutput todo
                 n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ)))
                 pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ))
             pure $
-              P.wrap "These types do not have any names in the current namespace:"
+              P.wrap "These types do not have any names in the current namespace."
                 <> P.newline
                 <> P.newline
                 <> P.indentN 2 (P.lines types)
@@ -2787,7 +2788,7 @@ handleTodoOutput todo
             -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one
             pure $
               P.wrap
-                "These types have some constructors with missing names:"
+                "These types have some constructors with missing names."
                 <> P.newline
                 <> P.newline
                 <> P.indentN 2 (P.lines types1)
@@ -2816,6 +2817,24 @@ handleTodoOutput todo
                   )
                 & P.sep "\n\n"
 
+      prettyStrayConstructors <-
+        case todo.incoherentDeclReasons.strayConstructors of
+          [] -> pure mempty
+          constructors0 -> do
+            constructors1 <-
+              for constructors0 \constructor -> do
+                n <- addNumberedArg (SA.Name constructor)
+                pure (formatNum n <> prettyName constructor)
+            -- Note [StrayConstructorMessage] If you change this, also change the other similar one
+            pure $
+              P.wrap
+                ( "These constructors are not nested beneath their corresponding type names. Please either move or"
+                    <> "delete them."
+                )
+                <> P.newline
+                <> P.newline
+                <> P.indentN 2 (P.lines constructors1)
+
       (pure . P.sep "\n\n" . P.nonEmpty)
         [ prettyDependentsOfTodo,
           prettyDirectTermDependenciesWithoutNames,
@@ -2824,7 +2843,8 @@ handleTodoOutput todo
           prettyDefnsInLib,
           prettyConstructorAliases,
           prettyMissingConstructorNames,
-          prettyNestedDeclAliases
+          prettyNestedDeclAliases,
+          prettyStrayConstructors
         ]
 
 listOfDefinitions ::
diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md
index d3cf81166..46e1eb616 100644
--- a/unison-src/transcripts/todo.md
+++ b/unison-src/transcripts/todo.md
@@ -164,3 +164,25 @@ scratch/main> todo
 ```ucm:hide
 scratch/main> delete.project scratch
 ```
+
+# Stray constructors
+
+The `todo` command complains about stray constructors.
+
+```ucm:hide
+scratch/main> builtins.mergeio lib.builtins
+```
+
+```unison
+type Foo = Bar
+```
+
+```ucm
+scratch/main> add
+scratch/main> alias.term Foo.Bar Baz
+scratch/main> todo
+```
+
+```ucm:hide
+scratch/main> delete.project scratch
+```
diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md
index 32b35c50b..38c6cdb56 100644
--- a/unison-src/transcripts/todo.output.md
+++ b/unison-src/transcripts/todo.output.md
@@ -44,7 +44,7 @@ scratch/main> add
 
 scratch/main> todo
 
-  These terms call `todo`:
+  These terms call `todo`.
   
     1. foo
 
@@ -95,7 +95,7 @@ scratch/main> delete.namespace.force foo
 
 scratch/main> todo
 
-  These terms do not have any names in the current namespace:
+  These terms do not have any names in the current namespace.
   
     1. #1jujb8oelv
 
@@ -256,7 +256,7 @@ scratch/main> delete.term Foo.Bar
 
 scratch/main> todo
 
-  These types have some constructors with missing names:
+  These types have some constructors with missing names.
   
     1. Foo
 
@@ -301,3 +301,43 @@ scratch/main> todo
     2. Foo.inner.Bar
 
 ```
+# Stray constructors
+
+The `todo` command complains about stray constructors.
+
+```unison
+type Foo = Bar
+```
+
+```ucm
+
+  Loading changes detected in scratch.u.
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      type Foo
+
+```
+```ucm
+scratch/main> add
+
+  ⍟ I've added these definitions:
+  
+    type Foo
+
+scratch/main> alias.term Foo.Bar Baz
+
+  Done.
+
+scratch/main> todo
+
+  These constructors are not nested beneath their corresponding
+  type names. Please either move or delete them.
+  
+    1. Baz
+
+```

From 1e5b925bcab2662eefd3b943a0b51e4a23d0fc66 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Tue, 9 Jul 2024 18:19:32 -0400
Subject: [PATCH 8/9] adjust some output

---
 .../src/Unison/CommandLine/OutputMessages.hs  | 77 +++++++++++++------
 unison-src/transcripts/todo.output.md         | 18 +++--
 2 files changed, 65 insertions(+), 30 deletions(-)

diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index d2684f190..4bc0ea47a 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -2686,7 +2686,7 @@ handleTodoOutput todo
                         & P.syntaxToColor
                 pure (formatNum n <> name)
             pure $
-              P.wrap "These terms call `todo`."
+              P.wrap "These terms call `todo`:"
                 <> P.newline
                 <> P.newline
                 <> P.indentN 2 (P.lines terms)
@@ -2700,7 +2700,7 @@ handleTodoOutput todo
                 n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term)))
                 pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term))
             pure $
-              P.wrap "These terms do not have any names in the current namespace."
+              P.wrap "These terms do not have any names in the current namespace:"
                 <> P.newline
                 <> P.newline
                 <> P.indentN 2 (P.lines terms)
@@ -2714,7 +2714,7 @@ handleTodoOutput todo
                 n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ)))
                 pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ))
             pure $
-              P.wrap "These types do not have any names in the current namespace."
+              P.wrap "These types do not have any names in the current namespace:"
                 <> P.newline
                 <> P.newline
                 <> P.indentN 2 (P.lines types)
@@ -2765,33 +2765,47 @@ handleTodoOutput todo
                     & map
                       ( \(typeName, prettyCon1, prettyCon2) ->
                           -- Note [ConstructorAliasMessage] If you change this, also change the other similar one
-                          P.wrap
-                            ( "The type"
-                                <> prettyName typeName
-                                <> "has a constructor with multiple names. Please delete all but one name for each"
-                                <> "constructor."
-                            )
+                          P.wrap ("The type" <> prettyName typeName <> "has a constructor with multiple names.")
                             <> P.newline
                             <> P.newline
                             <> P.indentN 2 (P.lines [prettyCon1, prettyCon2])
+                            <> P.newline
+                            <> P.newline
+                            <> P.wrap "Please delete all but one name for each constructor."
                       )
                     & P.sep "\n\n"
 
       prettyMissingConstructorNames <-
-        case todo.incoherentDeclReasons.missingConstructorNames of
-          [] -> pure mempty
-          types0 -> do
-            types1 <-
+        case NEList.nonEmpty todo.incoherentDeclReasons.missingConstructorNames of
+          Nothing -> pure mempty
+          Just types0 -> do
+            stuff <-
               for types0 \typ -> do
                 n <- addNumberedArg (SA.Name typ)
-                pure (formatNum n <> prettyName typ)
+                pure (n, typ)
             -- Note [MissingConstructorNameMessage] If you change this, also change the other similar one
             pure $
               P.wrap
                 "These types have some constructors with missing names."
                 <> P.newline
                 <> P.newline
-                <> P.indentN 2 (P.lines types1)
+                <> P.indentN 2 (P.lines (fmap (\(n, typ) -> formatNum n <> prettyName typ) stuff))
+                <> P.newline
+                <> P.newline
+                <> P.wrap
+                  ( "You can use"
+                      <> IP.makeExample
+                        IP.view
+                        [ let firstNum = fst (NEList.head stuff)
+                              lastNum = fst (NEList.last stuff)
+                           in if firstNum == lastNum
+                                then P.string (show firstNum)
+                                else P.string (show firstNum) <> "-" <> P.string (show lastNum)
+                        ]
+                      <> "and"
+                      <> IP.makeExample IP.aliasTerm ["<hash>", "<TypeName>.<ConstructorName>"]
+                      <> "to give names to each unnamed constructor."
+                  )
 
       prettyNestedDeclAliases <-
         case todo.incoherentDeclReasons.nestedDeclAliases of
@@ -2820,20 +2834,33 @@ handleTodoOutput todo
       prettyStrayConstructors <-
         case todo.incoherentDeclReasons.strayConstructors of
           [] -> pure mempty
-          constructors0 -> do
-            constructors1 <-
-              for constructors0 \constructor -> do
-                n <- addNumberedArg (SA.Name constructor)
-                pure (formatNum n <> prettyName constructor)
+          constructors -> do
+            nums <-
+              for constructors \constructor -> do
+                addNumberedArg (SA.Name constructor)
             -- Note [StrayConstructorMessage] If you change this, also change the other similar one
             pure $
-              P.wrap
-                ( "These constructors are not nested beneath their corresponding type names. Please either move or"
-                    <> "delete them."
-                )
+              P.wrap "These constructors are not nested beneath their corresponding type names:"
                 <> P.newline
                 <> P.newline
-                <> P.indentN 2 (P.lines constructors1)
+                <> P.indentN
+                  2
+                  ( P.lines
+                      ( zipWith
+                          (\n constructor -> formatNum n <> prettyName constructor)
+                          nums
+                          constructors
+                      )
+                  )
+                <> P.newline
+                <> P.newline
+                <> P.wrap
+                  ( "For each one, please either use"
+                      <> IP.makeExample' IP.moveAll
+                      <> "to move if, or if it's an extra copy, you can simply"
+                      <> IP.makeExample' IP.delete
+                      <> "it."
+                  )
 
       (pure . P.sep "\n\n" . P.nonEmpty)
         [ prettyDependentsOfTodo,
diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md
index 38c6cdb56..dbc5de722 100644
--- a/unison-src/transcripts/todo.output.md
+++ b/unison-src/transcripts/todo.output.md
@@ -44,7 +44,7 @@ scratch/main> add
 
 scratch/main> todo
 
-  These terms call `todo`.
+  These terms call `todo`:
   
     1. foo
 
@@ -95,7 +95,7 @@ scratch/main> delete.namespace.force foo
 
 scratch/main> todo
 
-  These terms do not have any names in the current namespace.
+  These terms do not have any names in the current namespace:
   
     1. #1jujb8oelv
 
@@ -215,11 +215,12 @@ scratch/main> alias.term Foo.One Foo.Two
 
 scratch/main> todo
 
-  The type Foo has a constructor with multiple names. Please
-  delete all but one name for each constructor.
+  The type Foo has a constructor with multiple names.
   
     1. Foo.One
     2. Foo.Two
+  
+  Please delete all but one name for each constructor.
 
 ```
 # Missing constructor names
@@ -259,6 +260,10 @@ scratch/main> todo
   These types have some constructors with missing names.
   
     1. Foo
+  
+  You can use `view 1` and
+  `alias.term <hash> <TypeName>.<ConstructorName>` to give names
+  to each unnamed constructor.
 
 ```
 # Nested decl aliases
@@ -336,8 +341,11 @@ scratch/main> alias.term Foo.Bar Baz
 scratch/main> todo
 
   These constructors are not nested beneath their corresponding
-  type names. Please either move or delete them.
+  type names:
   
     1. Baz
+  
+  For each one, please either use `move` to move if, or if it's
+  an extra copy, you can simply `delete` it.
 
 ```

From d78154d7c186c967a9eb12c0b661bd15427b663c Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Tue, 9 Jul 2024 18:58:42 -0400
Subject: [PATCH 9/9] better rendering of conflicted names in `todo`

---
 .../src/Unison/CommandLine/OutputMessages.hs  | 25 ++++++++++---------
 unison-src/transcripts/todo.output.md         |  6 +++--
 2 files changed, 17 insertions(+), 14 deletions(-)

diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index 4bc0ea47a..ef088071d 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -2593,20 +2593,20 @@ unsafePrettyTermResultSig' ppe = \case
     head (TypePrinter.prettySignaturesCT ppe [(r, name, typ)])
   _ -> error "Don't pass Nothing"
 
-renderNameConflicts :: PPE.PrettyPrintEnv -> Names -> Numbered Pretty
-renderNameConflicts ppe conflictedNames = do
+renderNameConflicts :: Int -> Names -> Numbered Pretty
+renderNameConflicts hashLen conflictedNames = do
   let conflictedTypeNames :: Map Name [HQ.HashQualified Name]
       conflictedTypeNames =
         conflictedNames
           & Names.types
           & R.domain
-          & fmap (foldMap (pure @[] . PPE.typeName ppe))
+          & Map.mapWithKey \name -> map (HQ.take hashLen . HQ.HashQualified name . Reference.toShortHash) . Set.toList
   let conflictedTermNames :: Map Name [HQ.HashQualified Name]
       conflictedTermNames =
         conflictedNames
           & Names.terms
           & R.domain
-          & fmap (foldMap (pure @[] . PPE.termName ppe))
+          & Map.mapWithKey \name -> map (HQ.take hashLen . HQ.HashQualified name . Referent.toShortHash) . Set.toList
   let allConflictedNames :: [Name]
       allConflictedNames = Set.toList (Map.keysSet conflictedTermNames <> Map.keysSet conflictedTypeNames)
   prettyConflictedTypes <- showConflictedNames "type" conflictedTypeNames
@@ -2639,13 +2639,14 @@ renderNameConflicts ppe conflictedNames = do
           prettyConflicts <- for hashes \hash -> do
             n <- addNumberedArg $ SA.HashQualified hash
             pure $ formatNum n <> (P.blue . P.syntaxToColor . prettyHashQualified $ hash)
-          pure . P.wrap $
-            ( "The "
-                <> thingKind
-                <> " "
-                <> P.green (prettyName name)
-                <> " has conflicting definitions:"
-            )
+          pure $
+            P.wrap
+              ( "The "
+                  <> thingKind
+                  <> " "
+                  <> P.green (prettyName name)
+                  <> " has conflicting definitions:"
+              )
               <> P.newline
               <> P.newline
               <> P.indentN 2 (P.lines prettyConflicts)
@@ -2722,7 +2723,7 @@ handleTodoOutput todo
       prettyConflicts <-
         if todo.nameConflicts == mempty
           then pure mempty
-          else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts
+          else renderNameConflicts todo.hashLen todo.nameConflicts
 
       let prettyDefnsInLib =
             if todo.defnsInLib
diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md
index dbc5de722..639de4e52 100644
--- a/unison-src/transcripts/todo.output.md
+++ b/unison-src/transcripts/todo.output.md
@@ -139,8 +139,10 @@ scratch/main> todo
 
   ❓
   
-  The term bar has conflicting definitions: 1. foo 2.
-  bar#cq22mm4sca
+  The term bar has conflicting definitions:
+  
+    1. bar#14ibahkll6
+    2. bar#cq22mm4sca
   
   Tip: Use `move.term` or `delete.term` to resolve the
        conflicts.