get dependents to upgrade

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

@@ -78,6 +78,7 @@ module Unison.Codebase.Branch
 
     -- ** Term/type queries
     deepReferents,
+    deepTermReferences,
     deepTypeReferences,
     consBranchSnapshot,
   )
@@ -120,13 +121,15 @@ import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment)
 import Unison.Prelude hiding (empty)
-import Unison.Reference (TypeReference)
+import Unison.Reference (TermReference, TypeReference)
 import Unison.Referent (Referent)
+import Unison.Referent qualified as Referent
 import Unison.Util.List qualified as List
 import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Relation qualified as R
 import Unison.Util.Relation qualified as Relation
 import Unison.Util.Relation4 qualified as R4
+import Unison.Util.Set qualified as Set
 import Unison.Util.Star3 qualified as Star3
 import Prelude hiding (head, read, subtract)
 
@@ -143,6 +146,10 @@ instance Hashing.ContentAddressable (Branch0 m) where
 deepReferents :: Branch0 m -> Set Referent
 deepReferents = R.dom . deepTerms
 
+deepTermReferences :: Branch0 m -> Set TermReference
+deepTermReferences =
+  Set.mapMaybe Referent.toTermReference . deepReferents
+
 deepTypeReferences :: Branch0 m -> Set TypeReference
 deepTypeReferences = R.dom . deepTypes
 

unison-cli/package.yaml

@@ -86,6 +86,7 @@ dependencies:
   - unison-sqlite
   - unison-syntax
   - unison-util-base32hex
+  - unison-util-nametree
   - unison-util-relation
   - unliftio
   - unordered-containers

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

@@ -33,6 +33,8 @@ module Unison.Cli.MonadUtils
     getMaybeBranchAt,
     expectBranchAtPath,
     expectBranchAtPath',
+    expectBranch0AtPath,
+    expectBranch0AtPath',
     assertNoBranchAtPath',
     branchExistsAtPath',
 
@@ -298,6 +300,16 @@ expectBranchAtPath' path0 = do
   path <- resolvePath' path0
   getMaybeBranchAt path & onNothingM (Cli.returnEarly (Output.BranchNotFound path0))
 
+-- | Get the branch0 at an absolute or relative path, or return early if there's no such branch.
+expectBranch0AtPath' :: Path' -> Cli (Branch0 IO)
+expectBranch0AtPath' =
+  fmap Branch.head . expectBranchAtPath'
+
+-- | Get the branch0 at a relative path, or return early if there's no such branch.
+expectBranch0AtPath :: Path -> Cli (Branch0 IO)
+expectBranch0AtPath =
+  expectBranch0AtPath' . Path' . Right . Path.Relative
+
 -- | Assert that there's "no branch" at an absolute or relative path, or return early if there is one, where "no branch"
 -- means either there's actually no branch, or there is a branch whose head is empty (i.e. it may have a history, but no
 -- current terms/types etc).

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

@@ -70,22 +70,15 @@ import Unison.Type (Type)
 import Unison.UnisonFile qualified as UF
 import Unison.UnisonFile.Names qualified as UF
 import Unison.UnisonFile.Type (TypecheckedUnisonFile, UnisonFile)
+import Unison.Util.Nametree (Defns (..))
 import Unison.Util.Pretty (Pretty)
 import Unison.Util.Pretty qualified as Pretty
 import Unison.Util.Relation qualified as Relation
-import Unison.Util.Set qualified as Set
 import Unison.Var (Var)
 
-data Defns terms types = Defns
-  { terms :: !terms,
-    types :: !types
-  }
-  deriving stock (Generic, Show)
-
 handleUpdate2 :: Cli ()
 handleUpdate2 = do
   Cli.Env {codebase} <- ask
-  -- - confirm all aliases updated together?
   tuf <- Cli.expectLatestTypecheckedFile
 
   -- - get add/updates from TUF
@@ -97,10 +90,10 @@ handleUpdate2 = do
 
   let ctorNames = forwardCtorNames namesExcludingLibdeps
 
-  (pped, bigUf) <- Cli.runTransactionWithRollback \_abort -> do
+  (pped, bigUf) <- Cli.runTransaction do
     dependents <-
       Ops.dependentsWithinScope
-        (namespaceReferences namesExcludingLibdeps)
+        (Names.referenceIds namesExcludingLibdeps)
         (getExistingReferencesNamed termAndDeclNames namesExcludingLibdeps)
     -- - construct PPE for printing UF* for typechecking (whatever data structure we decide to print)
     pped <- Codebase.hashLength <&> (`PPE.fromNamesDecl` (NamesWithHistory.fromCurrentNames namesIncludingLibdeps))
@@ -241,7 +234,12 @@ getExistingReferencesNamed defns names = fromTerms <> fromTypes
     fromTerms = foldMap (\n -> Set.map Referent.toReference $ Relation.lookupDom n $ Names.terms names) (defns ^. #terms)
     fromTypes = foldMap (\n -> Relation.lookupDom n $ Names.types names) (defns ^. #types)
 
-buildBigUnisonFile :: Codebase IO Symbol Ann -> TypecheckedUnisonFile Symbol Ann -> Map Reference.Id ReferenceType -> Names -> Transaction (UnisonFile Symbol Ann)
+buildBigUnisonFile ::
+  Codebase IO Symbol Ann ->
+  TypecheckedUnisonFile Symbol Ann ->
+  Map Reference.Id ReferenceType ->
+  Names ->
+  Transaction (UnisonFile Symbol Ann)
 buildBigUnisonFile c tuf dependents names =
   -- for each dependent, add its definition with all its names to the UnisonFile
   foldM addComponent (UF.discardTypes tuf) (Map.toList dependents')
@@ -346,12 +344,6 @@ incrementLastSegmentChar (ForwardName segments) =
               else Text.init text `Text.append` Text.singleton (succ $ Text.last text)
        in NameSegment incrementedText
 
-namespaceReferences :: Names -> Set Reference.Id
-namespaceReferences names = fromTerms <> fromTypes
-  where
-    fromTerms = Set.mapMaybe Referent.toReferenceId (Relation.ran $ Names.terms names)
-    fromTypes = Set.mapMaybe Reference.toId (Relation.ran $ Names.types names)
-
 getTermAndDeclNames :: Var v => TypecheckedUnisonFile v a -> Defns (Set Name) (Set Name)
 getTermAndDeclNames tuf = Defns (terms <> effectCtors <> dataCtors) (effects <> datas)
   where

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

@@ -3,14 +3,20 @@ module Unison.Codebase.Editor.HandleInput.Upgrade
   )
 where
 
+import Control.Lens (over)
+import Data.Map.Strict qualified as Map
+import U.Codebase.Sqlite.Operations qualified as Operations
 import Unison.Cli.Monad (Cli)
+import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
+import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Branch.Names qualified as Branch
 import Unison.Codebase.Path qualified as Path
 import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment)
 import Unison.Names (Names)
+import Unison.Names qualified as Names
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
@@ -19,10 +25,18 @@ import Unison.UnisonFile (UnisonFile)
 
 handleUpgrade :: NameSegment -> NameSegment -> Cli ()
 handleUpgrade oldDepName newDepName = do
-  oldDepBranch <- Cli.expectBranchAtPath (Path.fromList [Name.libSegment, oldDepName])
-  newDepBranch <- Cli.expectBranchAtPath (Path.fromList [Name.libSegment, newDepName])
+  oldDepBranch <- Cli.expectBranch0AtPath (Path.fromList [Name.libSegment, oldDepName])
+  newDepBranch <- Cli.expectBranch0AtPath (Path.fromList [Name.libSegment, newDepName])
   currentBranch <- Cli.getCurrentBranch0
 
+  let namesExcludingLibdeps = Branch.toNames (currentBranch & over Branch.children (Map.delete Name.libSegment))
+
+  dependents <-
+    Cli.runTransaction do
+      Operations.dependentsWithinScope
+        (Names.referenceIds namesExcludingLibdeps)
+        (Branch.deepTermReferences oldDepBranch <> Branch.deepTypeReferences newDepBranch)
+
   let allNames = Branch.toNames currentBranch
 
   -- Compute "fake names": these are all of things in `lib.old`, with the `old` segment swapped out for `new`

unison-cli/unison-cli.cabal

@@ -229,6 +229,7 @@ library
     , unison-sqlite
     , unison-syntax
     , unison-util-base32hex
+    , unison-util-nametree
     , unison-util-relation
     , unliftio
     , unordered-containers
@@ -367,6 +368,7 @@ executable cli-integration-tests
     , unison-sqlite
     , unison-syntax
     , unison-util-base32hex
+    , unison-util-nametree
     , unison-util-relation
     , unliftio
     , unordered-containers
@@ -500,6 +502,7 @@ executable transcripts
     , unison-sqlite
     , unison-syntax
     , unison-util-base32hex
+    , unison-util-nametree
     , unison-util-relation
     , unliftio
     , unordered-containers
@@ -639,6 +642,7 @@ executable unison
     , unison-sqlite
     , unison-syntax
     , unison-util-base32hex
+    , unison-util-nametree
     , unison-util-relation
     , unliftio
     , unordered-containers
@@ -781,6 +785,7 @@ test-suite cli-tests
     , unison-sqlite
     , unison-syntax
     , unison-util-base32hex
+    , unison-util-nametree
     , unison-util-relation
     , unliftio
     , unordered-containers

unison-core/src/Unison/Names.hs

@@ -30,6 +30,7 @@ module Unison.Names
     restrictReferences,
     refTermsNamed,
     refTermsHQNamed,
+    referenceIds,
     termReferences,
     termReferents,
     typeReferences,
@@ -150,6 +151,14 @@ fuzzyFind nameToText query names =
                       query
             )
 
+-- | Get all (untagged) term/type references ids in a @Names@.
+referenceIds :: Names -> Set Reference.Id
+referenceIds Names {terms, types} =
+  fromTerms <> fromTypes
+  where
+    fromTerms = Set.mapMaybe Referent.toReferenceId (Relation.ran terms)
+    fromTypes = Set.mapMaybe Reference.toId (Relation.ran types)
+
 termReferences :: Names -> Set TermReference
 termReferences Names {..} = Set.map Referent.toReference $ R.ran terms