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/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 f263bd660..33ab84de7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/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 <- - 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 @@ -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 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 1a8ccf64f..108ceee2a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/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 } diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 1eb7fda3c..a85360dc4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/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 diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index c06408578..d04a8aa4b 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 @@ -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 ["", prettyName name <> "."] <> "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 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 @@ -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 $ - ( "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) @@ -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 ["", "."] + <> "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 :: 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 diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 2a75252fc..302e46a29 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/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 - (_, 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) (checkDeclCoherencyWith_DoTerms 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) + (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 + +checkDeclCoherencyWith_DoTerms :: + forall m. + Monad m => + OnIncoherentDeclReasons m -> + [NameSegment] -> + (NameSegment, Referent) -> + StateT DeclCoherencyCheckState m () +checkDeclCoherencyWith_DoTerms 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) + +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) - 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. diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md index b86a36e20..46e1eb616 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,143 @@ 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 +``` + +# 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 ``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md index c29c70e12..9b4ba914b 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,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 .` 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. + +```