Merge remote-tracking branch 'upstream/trunk' into new-transcript-parser

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

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

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,

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

@@ -9,6 +9,9 @@ module Unison.Codebase.Editor.HandleInput.Merge2
     LcaMergeInfo (..),
     doMerge,
     doMergeLocalBranch,
+
+    -- * API exported for @todo@
+    hasDefnsInLib,
   )
 where
 
@@ -86,6 +89,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
@@ -139,7 +143,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
@@ -239,11 +242,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 <-
+        whenM (Cli.runTransaction (hasDefnsInLib branch)) do
-          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
           done (Output.MergeDefnsInLib who)
 
       -- Load Alice/Bob/LCA definitions and decl name lookups
@@ -486,6 +485,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
 

unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs

@@ -4,7 +4,9 @@ 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
 import Unison.Builtin qualified as Builtin
 import Unison.Cli.Monad (Cli)
@@ -14,7 +16,11 @@ 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.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..), checkAllDeclCoherency)
 import Unison.Names qualified as Names
 import Unison.Prelude
 import Unison.Reference (TermReference)
@@ -26,11 +32,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, 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
+        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,20 +68,28 @@ handleTodo = do
 
       hashLen <- Codebase.hashLength
 
-      pure (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,
           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
         }

unison-cli/src/Unison/Codebase/Editor/Output.hs

@@ -54,6 +54,7 @@ import Unison.Hash (Hash)
 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)
@@ -154,9 +155,11 @@ 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,
+    incoherentDeclReasons :: !IncoherentDeclReasons,
     nameConflicts :: !Names,
     ppe :: !PrettyPrintEnvDecl
   }
@@ -166,6 +169,8 @@ todoOutputIsEmpty todo =
   Set.null todo.dependentsOfTodo
     && defnsAreEmpty todo.directDependenciesWithoutNames
     && Names.isEmpty todo.nameConflicts
+    && not todo.defnsInLib
+    && todo.incoherentDeclReasons == IncoherentDeclReasons [] [] [] []
 
 data AmbiguousReset'Argument
   = AmbiguousReset'Hash

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
@@ -1401,6 +1402,7 @@ 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:",
@@ -1416,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:",
@@ -1428,6 +1431,7 @@ notifyUser dir = \case
         "",
         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:",
@@ -1446,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"
@@ -1456,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 $
@@ -2607,20 +2613,20 @@ unsafePrettyTermResultSig' ppe = \case
     head (TypePrinter.prettySignaturesCT ppe [(r, name, typ)])
   _ -> error "Don't pass Nothing"
 
-renderNameConflicts :: PPE.PrettyPrintEnv -> Names -> Numbered Pretty
+renderNameConflicts :: Int -> Names -> Numbered Pretty
-renderNameConflicts ppe conflictedNames = do
+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
@@ -2653,13 +2659,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 $
+          pure $
-            ( "The "
+            P.wrap
-                <> thingKind
+              ( "The "
-                <> " "
+                  <> thingKind
-                <> P.green (prettyName name)
+                  <> " "
-                <> " has conflicting definitions:"
+                  <> P.green (prettyName name)
-            )
+                  <> " has conflicting definitions:"
+              )
               <> P.newline
               <> P.newline
               <> P.indentN 2 (P.lines prettyConflicts)
@@ -2685,11 +2692,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
@@ -2738,11 +2740,159 @@ handleTodoOutput todo
                 <> P.newline
                 <> P.indentN 2 (P.lines types)
 
+      prettyConflicts <-
+        if todo.nameConflicts == mempty
+          then pure mempty
+          else renderNameConflicts todo.hashLen 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
+
+      prettyConstructorAliases <-
+        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.")
+                            <> 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 NEList.nonEmpty todo.incoherentDeclReasons.missingConstructorNames of
+          Nothing -> pure mempty
+          Just types0 -> do
+            stuff <-
+              for types0 \typ -> do
+                n <- addNumberedArg (SA.Name 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 (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
+          [] -> 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"
+
+      prettyStrayConstructors <-
+        case todo.incoherentDeclReasons.strayConstructors of
+          [] -> pure mempty
+          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:"
+                <> P.newline
+                <> P.newline
+                <> 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,
           prettyDirectTermDependenciesWithoutNames,
           prettyDirectTypeDependenciesWithoutNames,
-          prettyConflicts
+          prettyConflicts,
+          prettyDefnsInLib,
+          prettyConstructorAliases,
+          prettyMissingConstructorNames,
+          prettyNestedDeclAliases,
+          prettyStrayConstructors
         ]
 
 listOfDefinitions ::

unison-core/package.yaml

@@ -66,6 +66,7 @@ default-extensions:
   - DerivingStrategies
   - DerivingVia
   - DoAndIfThenElse
+  - DuplicateRecordFields
   - FlexibleContexts
   - FlexibleInstances
   - GADTs

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 Left <$> R.toMultimap names.terms)
-      <> (Set.mapMonotonic Right <$> R.toMultimap (types names))
+      <> (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)
+    terms' = foldl' go a.terms (R.toList b.terms)
-    types' = foldl' go (types a) (R.toList $ types b)
+    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 a.terms b.terms)
-    (R.difference (types a) (types b))
+    (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 ns.terms shortToLongName)
-    (foldl' go (types ns) 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 ns.terms]
-    <> [(suffix, full) | Just (suffix, full) <- go <$> R.toList (types ns)]
+    <> [(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

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

unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs

@@ -83,15 +83,17 @@ module Unison.Merge.DeclCoherencyCheck
   ( IncoherentDeclReason (..),
     checkDeclCoherency,
     lenientCheckDeclCoherency,
+
+    -- * Getting all failures rather than just the first
+    IncoherentDeclReasons (..),
+    checkAllDeclCoherency,
   )
 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 +138,190 @@ 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 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 (),
+    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
+      for_ (Map.toList defns.terms) (checkDeclCoherencyWith_DoTerms callbacks prefix)
-        (_, 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
-
       childrenWeWentInto <-
-        forMaybe (Map.toList defns.types) \case
+        forMaybe
-          (_, ReferenceBuiltin _) -> pure Nothing
+          (Map.toList defns.types)
-          (name, ReferenceDerived typeRef) -> do
+          (checkDeclCoherencyWith_DoTypes loadDeclNumConstructors callbacks go prefix children)
-            DeclCoherencyCheckState {expectedConstructors} <- State.get
+      let childrenWeHaventGoneInto = children `Map.withoutKeys` Set.fromList childrenWeWentInto
-            whatHappened <- do
+      for_ (Map.toList childrenWeHaventGoneInto) \(name, child) -> go (name : prefix) child
-              let recordNewDecl ::
+
-                    Maybe (Name, ConstructorNames) ->
+checkDeclCoherencyWith_DoTerms ::
-                    Compose (ExceptT IncoherentDeclReason m) WhatHappened (Name, ConstructorNames)
+  forall m.
-                  recordNewDecl =
+  Monad m =>
-                    Compose . \case
+  OnIncoherentDeclReasons m ->
-                      Just (shorterTypeName, _) -> Except.throwError (IncoherentDeclReason'NestedDeclAlias shorterTypeName typeName)
+  [NameSegment] ->
-                      Nothing ->
+  (NameSegment, Referent) ->
-                        lift (loadDeclNumConstructors typeRef) <&> \case
+  StateT DeclCoherencyCheckState m ()
-                          0 -> UninhabitedDecl
+checkDeclCoherencyWith_DoTerms callbacks prefix = \case
-                          n -> InhabitedDecl (typeName, emptyConstructorNames n)
+  (_, Referent.Ref _) -> pure ()
-              lift (getCompose (Map.upsertF recordNewDecl typeRef expectedConstructors))
+  (_, Referent.Con (ConstructorReference (ReferenceBuiltin _) _) _) -> pure ()
-            case whatHappened of
+  (name, Referent.Con (ConstructorReference (ReferenceDerived typeRef) conId) _) -> do
-              UninhabitedDecl -> do
+    state <- State.get
-                #declNameLookup . #declToConstructors %= Map.insert typeName []
+    whenJustM (lift (runMaybeT (Map.upsertF f typeRef state.expectedConstructors))) \expectedConstructors1 ->
-                pure Nothing
+      #expectedConstructors .= expectedConstructors1
-              InhabitedDecl expectedConstructors1 -> do
+    where
-                child <-
+      f :: Maybe (Name, ConstructorNames) -> MaybeT m (Name, ConstructorNames)
-                  Map.lookup name children & onNothing do
+      f = \case
-                    Except.throwError (IncoherentDeclReason'MissingConstructorName typeName)
+        Nothing -> do
-                #expectedConstructors .= expectedConstructors1
+          lift (callbacks.onStrayConstructor name1)
-                go (name : prefix) child
+          MaybeT (pure Nothing)
-                DeclCoherencyCheckState {expectedConstructors} <- State.get
+        Just (typeName, expected) ->
-                -- fromJust is safe here because we upserted `typeRef` key above
+          case recordConstructorName conId name1 expected of
-                let (fromJust -> (_typeName, maybeConstructorNames), expectedConstructors1) =
+            Left existingName -> do
-                      Map.deleteLookup typeRef expectedConstructors
+              lift (callbacks.onConstructorAlias typeName existingName name1)
-                constructorNames <-
+              MaybeT (pure Nothing)
-                  sequence (IntMap.elems maybeConstructorNames) & onNothing do
+            Right expected1 -> pure (typeName, expected1)
-                    Except.throwError (IncoherentDeclReason'MissingConstructorName typeName)
+        where
-                #expectedConstructors .= expectedConstructors1
+          name1 =
+            Name.fromReverseSegments (name :| prefix)
+
+checkDeclCoherencyWith_DoTypes ::
+  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)
+checkDeclCoherencyWith_DoTypes 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)
+            pure (Just name)
-            where
+    where
-              typeName = fullName name
+      typeName =
-
+        Name.fromReverseSegments (name :| prefix)
-      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)
 
 -- | 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.

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
+scratch/main> add
-project/main> todo
+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,143 @@ baz = foo.bar + foo.bar
 ```
 
 ```ucm
-project/main> add
+scratch/main> add
-project/main> delete.namespace.force foo
+scratch/main> delete.namespace.force foo
-project/main> todo
+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
+```
+
+# 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
+```
+
+# 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
+```
+
+# 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
+```
+
+# 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
 ```

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,261 @@ 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. bar#14ibahkll6
+    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.
+
+```
+# 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.
+  
+    1. Foo.One
+    2. Foo.Two
+  
+  Please delete all but one name for each constructor.
+
+```
+# 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
+  
+  You can use `view 1` and
+  `alias.term <hash> <TypeName>.<ConstructorName>` to give names
+  to each unnamed constructor.
+
+```
+# 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
+
+```
+# 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:
+  
+    1. Baz
+  
+  For each one, please either use `move` to move if, or if it's
+  an extra copy, you can simply `delete` it.
+
+```