feat/bugfix: on failed update, put dependents below definitions that were in file before running update

lib/unison-util-relation/src/Unison/Util/BiMultimap.hs

@@ -3,6 +3,9 @@ module Unison.Util.BiMultimap
   ( BiMultimap,
     Unison.Util.BiMultimap.empty,
 
+    -- ** Basic queries
+    isEmpty,
+
     -- ** Lookup
     memberDom,
     lookupDom,
@@ -32,6 +35,9 @@ module Unison.Util.BiMultimap
     dom,
     ran,
 
+    -- ** Relations
+    toRelation,
+
     -- ** Insert
     insert,
     unsafeInsert,
@@ -47,6 +53,8 @@ import Data.Set.NonEmpty (NESet)
 import Data.Set.NonEmpty qualified as Set.NonEmpty
 import Unison.Prelude
 import Unison.Util.Map qualified as Map
+import Unison.Util.Relation (Relation)
+import Unison.Util.Relation qualified as Relation
 import Prelude hiding (filter)
 
 -- | A left-unique relation.
@@ -62,6 +70,11 @@ data BiMultimap a b = BiMultimap
 empty :: (Ord a, Ord b) => BiMultimap a b
 empty = BiMultimap mempty mempty
 
+-- | Is a left-unique relation empty?
+isEmpty :: BiMultimap a b -> Bool
+isEmpty =
+  Map.null . domain
+
 memberDom :: (Ord a) => a -> BiMultimap a b -> Bool
 memberDom x =
   Map.member x . domain
@@ -200,6 +213,11 @@ ran :: BiMultimap a b -> Set b
 ran =
   Map.keysSet . toMapR
 
+-- | Convert a left-unique relation to a relation (forgetting its left-uniqueness).
+toRelation :: (Ord a, Ord b) => BiMultimap a b -> Relation a b
+toRelation =
+  Relation.fromMultimap . Map.map Set.NonEmpty.toSet . domain
+
 -- | Insert a pair into a left-unique relation, maintaining left-uniqueness, preferring the latest inserted element.
 --
 -- That is, if a left-unique relation already contains the pair @(x, y)@, then inserting the pair @(z, y)@ will cause

parser-typechecker/src/Unison/Codebase/Branch.hs

@@ -86,6 +86,7 @@ module Unison.Codebase.Branch
     -- ** Term/type queries
     deepTerms,
     deepTypes,
+    deepDefns,
     deepEdits,
     deepPaths,
     deepReferents,
@@ -112,6 +113,7 @@ import Unison.Codebase.Branch.Type
     UnwrappedBranch,
     branch0,
     children,
+    deepDefns,
     deepEdits,
     deepPaths,
     deepTerms,

parser-typechecker/src/Unison/Codebase/Branch/Type.hs

@@ -10,15 +10,16 @@ module Unison.Codebase.Branch.Type
     Branch (..),
     Branch0,
     branch0,
-    terms,
-    types,
+    Unison.Codebase.Branch.Type.terms,
+    Unison.Codebase.Branch.Type.types,
     children,
     nonEmptyChildren,
     history,
     edits,
     isEmpty0,
     deepTerms,
     deepTypes,
+    deepDefns,
     deepPaths,
     deepEdits,
     Star,
@@ -47,9 +48,11 @@ import Unison.NameSegment qualified as NameSegment
 import Unison.Prelude hiding (empty)
 import Unison.Reference (Reference, TypeReference)
 import Unison.Referent (Referent)
+import Unison.Util.Defns (Defns (..), DefnsF)
 import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Relation (Relation)
 import Unison.Util.Relation qualified as R
+import Unison.Util.Relation qualified as Relation
 import Unison.Util.Star2 qualified as Star2
 import Prelude hiding (head, read, subtract)
 
@@ -148,6 +151,13 @@ deepTerms = _deepTerms
 deepTypes :: Branch0 m -> Relation TypeReference Name
 deepTypes = _deepTypes
 
+deepDefns :: Branch0 m -> DefnsF (Relation Name) Referent TypeReference
+deepDefns branch =
+  Defns
+    { terms = Relation.swap (deepTerms branch),
+      types = Relation.swap (deepTypes branch)
+    }
+
 deepPaths :: Branch0 m -> Set Path
 deepPaths = _deepPaths
 

parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs

@@ -1,8 +1,11 @@
 module Unison.PrettyPrintEnvDecl.Names
   ( makePPED,
+    makeFilePPED,
+    makeCodebasePPED,
   )
 where
 
+import Unison.Names (Names)
 import Unison.PrettyPrintEnv.Names qualified as PPE
 import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (PrettyPrintEnvDecl))
 
@@ -11,3 +14,23 @@ makePPED namer suffixifier =
   PrettyPrintEnvDecl
     (PPE.makePPE namer PPE.dontSuffixify)
     (PPE.makePPE namer suffixifier)
+
+-- | Make a PPED suitable for names in a Unison file.
+--
+-- Such names have special suffixification rules: aliases may *not* be referred to by a common suffix. For example, if
+-- a file contains
+--
+--   one.foo = 6
+--   two.foo = 6
+--
+-- then the suffix `foo` will *not* be accepted (currently). So, this PPE uses the "suffixify by name" strategy.
+makeFilePPED :: Names -> PrettyPrintEnvDecl
+makeFilePPED names =
+  makePPED (PPE.namer names) (PPE.suffixifyByName names)
+
+-- | Make a PPED suitable for names in the codebase. These names are hash qualified and suffixified by hash.
+makeCodebasePPED :: Names -> PrettyPrintEnvDecl
+makeCodebasePPED names =
+  makePPED
+    (PPE.hqNamer 10 names)
+    (PPE.suffixifyByHash names)

parser-typechecker/src/Unison/UnisonFile.hs

@@ -36,6 +36,8 @@ module Unison.UnisonFile
     typecheckedUnisonFile,
     Unison.UnisonFile.rewrite,
     prepareRewrite,
+    termNamespaceBindings,
+    typeNamespaceBindings,
   )
 where
 
@@ -49,6 +51,7 @@ import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.ConstructorType qualified as CT
 import Unison.DataDeclaration (DataDeclaration, EffectDeclaration (..))
 import Unison.DataDeclaration qualified as DD
+import Unison.DataDeclaration qualified as DataDeclaration
 import Unison.Hash qualified as Hash
 import Unison.Hashing.V2.Convert qualified as Hashing
 import Unison.LabeledDependency (LabeledDependency)
@@ -67,6 +70,7 @@ import Unison.Util.List qualified as List
 import Unison.Var (Var)
 import Unison.Var qualified as Var
 import Unison.WatchKind (WatchKind, pattern TestWatch)
+import Unison.WatchKind qualified as WatchKind
 
 -- | An empty Unison file.
 emptyUnisonFile :: UnisonFile v a
@@ -390,3 +394,28 @@ constructorsForDecls types uf =
           & fmap (DD.toDataDecl . snd)
           & concatMap DD.constructorVars
    in Set.fromList (dataConstructors <> effectConstructors)
+
+-- | All bindings in the term namespace: terms, test watches (since those are the only watches that are actually stored
+-- in the codebase), data constructors, and effect constructors.
+termNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v
+termNamespaceBindings uf =
+  terms <> tests <> datacons <> effcons
+  where
+    terms = foldMap (Set.fromList . map (view _1)) uf.topLevelComponents'
+    tests =
+      uf.watchComponents & foldMap \case
+        (WatchKind.TestWatch, watches) -> Set.fromList (map (view _1) watches)
+        _ -> Set.empty
+    datacons = foldMap (Set.fromList . DataDeclaration.constructorVars . view _2) uf.dataDeclarationsId'
+    effcons =
+      foldMap
+        (Set.fromList . DataDeclaration.constructorVars . DataDeclaration.toDataDecl . view _2)
+        uf.effectDeclarationsId'
+
+-- | All bindings in the term namespace: data declarations and effect declarations.
+typeNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v
+typeNamespaceBindings uf =
+  datas <> effs
+  where
+    datas = Map.keysSet uf.dataDeclarationsId'
+    effs = Map.keysSet uf.effectDeclarationsId'

unison-cli/src/Unison/Cli/MonadUtils.hs

@@ -79,6 +79,9 @@ module Unison.Cli.MonadUtils
     expectLatestParsedFile,
     getLatestTypecheckedFile,
     expectLatestTypecheckedFile,
+
+    -- * Parsing env
+    makeParsingEnv,
   )
 where
 
@@ -98,6 +101,7 @@ import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
 import U.Codebase.Sqlite.Queries qualified as Q
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
+import Unison.Cli.UniqueTypeGuidLookup (loadUniqueTypeGuid)
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch (..), Branch0)
 import Unison.Codebase.Branch qualified as Branch
@@ -122,9 +126,11 @@ import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
 import Unison.Reference (TypeReference)
 import Unison.Referent (Referent)
+import Unison.Sqlite (Transaction)
 import Unison.Sqlite qualified as Sqlite
 import Unison.Symbol (Symbol)
 import Unison.Syntax.Name qualified as Name (toText)
+import Unison.Syntax.Parser (ParsingEnv (..))
 import Unison.Term qualified as Term
 import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile)
 import Unison.UnisonFile qualified as UF
@@ -554,3 +560,15 @@ getNamesFromLatestFile = do
 expectLatestTypecheckedFile :: Cli (TypecheckedUnisonFile Symbol Ann)
 expectLatestTypecheckedFile =
   getLatestTypecheckedFile & onNothingM (Cli.returnEarly Output.NoUnisonFile)
+
+-- @makeParsingEnv path names@ makes a parsing environment with @names@ in scope, which are all relative to @path@.
+makeParsingEnv :: ProjectPath -> Names -> Cli (ParsingEnv Transaction)
+makeParsingEnv path names = do
+  Cli.Env {generateUniqueName} <- ask
+  uniqueName <- liftIO generateUniqueName
+  pure do
+    ParsingEnv
+      { uniqueNames = uniqueName,
+        uniqueTypeGuid = loadUniqueTypeGuid path,
+        names
+      }