mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Merge remote-tracking branch 'upstream/trunk' into new-transcript-parser
This commit is contained in:
commit
bf442467a4
@ -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
|
||||
|
@ -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
|
||||
|
@ -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,
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
}
|
||||
|
@ -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
|
||||
|
@ -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 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 ["<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 ::
|
||||
|
@ -66,6 +66,7 @@ default-extensions:
|
||||
- DerivingStrategies
|
||||
- DerivingVia
|
||||
- DoAndIfThenElse
|
||||
- DuplicateRecordFields
|
||||
- FlexibleContexts
|
||||
- FlexibleInstances
|
||||
- GADTs
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
```
|
||||
|
@ -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.
|
||||
|
||||
```
|
||||
|
Loading…
Reference in New Issue
Block a user