Merge pull request #5124 from unisonweb/24-06-24-todo-dependents

Author: aryairani

codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs

@@ -66,7 +66,8 @@ module U.Codebase.Sqlite.Operations
     directDependenciesOfScope,
     dependents,
     dependentsOfComponent,
-    dependentsWithinScope,
+    directDependentsWithinScope,
+    transitiveDependentsWithinScope,
 
     -- ** type index
     Q.addTypeToIndexForTerm,
@@ -1154,19 +1155,43 @@ dependents selector r = do
       sIds <- Q.getDependentsForDependency selector r'
       Set.traverse s2cReferenceId sIds
 
--- | `dependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not
--- including `query` itself). Each dependent is also tagged with whether it is a term or decl.
-dependentsWithinScope :: Set C.Reference.Id -> Set C.Reference -> Transaction (Map C.Reference.Id C.ReferenceType)
-dependentsWithinScope scope query = do
-  scope' <- Set.traverse c2sReferenceId scope
-  query' <- Set.traverse c2sReference query
-  Q.getDependentsWithinScope scope' query'
-    >>= Map.bitraverse s2cReferenceId (pure . objectTypeToReferenceType)
-  where
-    objectTypeToReferenceType = \case
-      ObjectType.TermComponent -> C.RtTerm
-      ObjectType.DeclComponent -> C.RtType
-      _ -> error "Q.getDependentsWithinScope shouldn't return any other types"
+-- | `directDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not
+-- including `query` itself).
+directDependentsWithinScope ::
+  Set C.Reference.Id ->
+  Set C.Reference ->
+  Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId)
+directDependentsWithinScope scope0 query0 = do
+  -- Convert C -> S
+  scope1 <- Set.traverse c2sReferenceId scope0
+  query1 <- Set.traverse c2sReference query0
+
+  -- Do the query
+  dependents0 <- Q.getDirectDependentsWithinScope scope1 query1
+
+  -- Convert S -> C
+  dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0
+
+  pure dependents1
+
+-- | `transitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope` (not
+-- including `query` itself).
+transitiveDependentsWithinScope ::
+  Set C.Reference.Id ->
+  Set C.Reference ->
+  Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId)
+transitiveDependentsWithinScope scope0 query0 = do
+  -- Convert C -> S
+  scope1 <- Set.traverse c2sReferenceId scope0
+  query1 <- Set.traverse c2sReference query0
+
+  -- Do the query
+  dependents0 <- Q.getTransitiveDependentsWithinScope scope1 query1
+
+  -- Convert S -> C
+  dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0
+
+  pure dependents1
 
 -- | returns a list of known definitions referencing `h`
 dependentsOfComponent :: H.Hash -> Transaction (Set C.Reference.Id)

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -166,7 +166,8 @@ module U.Codebase.Sqlite.Queries
     getDependencyIdsForDependent,
     getDependenciesBetweenTerms,
     getDirectDependenciesOfScope,
-    getDependentsWithinScope,
+    getDirectDependentsWithinScope,
+    getTransitiveDependentsWithinScope,
 
     -- ** type index
     addToTypeIndex,
@@ -1913,28 +1914,68 @@ getDirectDependenciesOfScope scope = do
 
   pure dependencies1
 
-{- ORMOLU_DISABLE -}
+-- | `getDirectDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not
+-- including `query` itself).
+getDirectDependentsWithinScope ::
+  Set S.Reference.Id ->
+  Set S.Reference ->
+  Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId)
+getDirectDependentsWithinScope scope query = do
+  -- Populate a temporary table with all of the references in `scope`
+  let scopeTableName = [sql| dependents_search_scope |]
+  createTemporaryTableOfReferenceIds scopeTableName scope
+
+  -- Populate a temporary table with all of the references in `query`
+  let queryTableName = [sql| dependencies_query |]
+  createTemporaryTableOfReferences queryTableName query
+
+  -- Get their direct dependents (tagged with object type)
+  dependents0 <-
+    queryListRow @(S.Reference.Id :. Only ObjectType)
+      [sql|
+        SELECT s.object_id, s.component_index, o.type_id
+        FROM $queryTableName q
+          JOIN dependents_index d
+            ON q.builtin IS d.dependency_builtin
+            AND q.object_id IS d.dependency_object_id
+            AND q.component_index IS d.dependency_component_index
+          JOIN $scopeTableName s
+            ON d.dependent_object_id = s.object_id
+            AND d.dependent_component_index = s.component_index
+          JOIN object o ON s.object_id = o.id
+      |]
+
+  -- Drop the temporary tables
+  execute [sql| DROP TABLE $scopeTableName |]
+  execute [sql| DROP TABLE $queryTableName |]
+
+  -- Post-process the query result
+  let dependents1 =
+        List.foldl'
+          ( \deps -> \case
+              dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types
+              dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types)
+              _ -> deps -- impossible; could error here
+          )
+          (Defns Set.empty Set.empty)
+          dependents0
+
+  pure dependents1
 
--- | `getDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not
--- including `query` itself). Each dependent is also tagged with whether it is a term or decl.
-getDependentsWithinScope :: Set S.Reference.Id -> Set S.Reference -> Transaction (Map S.Reference.Id ObjectType)
-getDependentsWithinScope scope query = do
+-- | `getTransitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope`
+-- (not including `query` itself).
+getTransitiveDependentsWithinScope ::
+  Set S.Reference.Id ->
+  Set S.Reference ->
+  Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId)
+getTransitiveDependentsWithinScope scope query = do
   -- Populate a temporary table with all of the references in `scope`
-  createTemporaryTableOfReferenceIds [sql| dependents_search_scope |] scope
+  let scopeTableName = [sql| dependents_search_scope |]
+  createTemporaryTableOfReferenceIds scopeTableName scope
 
   -- Populate a temporary table with all of the references in `query`
-  execute
-    [sql|
-      CREATE TEMPORARY TABLE dependencies_query (
-        dependency_builtin INTEGER NULL,
-        dependency_object_id INTEGER NULL,
-        dependency_component_index INTEGER NULL,
-        CHECK ((dependency_builtin IS NULL) = (dependency_object_id IS NOT NULL)),
-        CHECK ((dependency_object_id IS NULL) = (dependency_component_index IS NULL))
-      )
-    |]
-  for_ query \r ->
-    execute [sql|INSERT INTO dependencies_query VALUES (@r, @, @)|]
+  let queryTableName = [sql| dependencies_query |]
+  createTemporaryTableOfReferences queryTableName query
 
   -- Say the query set is { #foo, #bar }, and the scope set is { #foo, #bar, #baz, #qux, #honk }.
   --
@@ -1954,34 +1995,65 @@ getDependentsWithinScope scope query = do
   -- We use `UNION` rather than `UNION ALL` so as to not track down the transitive dependents of any particular
   -- reference more than once.
 
-  result :: [S.Reference.Id :. Only ObjectType] <- queryListRow [sql|
-    WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS (
-      SELECT d.dependent_object_id, d.dependent_component_index, object.type_id
-      FROM dependents_index d
-      JOIN object ON d.dependent_object_id = object.id
-      JOIN dependencies_query q
-        ON q.dependency_builtin IS d.dependency_builtin
-        AND q.dependency_object_id IS d.dependency_object_id
-        AND q.dependency_component_index IS d.dependency_component_index
-      JOIN dependents_search_scope s
-        ON s.object_id = d.dependent_object_id
-        AND s.component_index = d.dependent_component_index
-
-      UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id
-      FROM dependents_index d
-      JOIN object ON d.dependent_object_id = object.id
-      JOIN transitive_dependents t
-        ON t.dependent_object_id = d.dependency_object_id
-        AND t.dependent_component_index = d.dependency_component_index
-      JOIN dependents_search_scope s
-        ON s.object_id = d.dependent_object_id
-        AND s.component_index = d.dependent_component_index
-    )
-    SELECT * FROM transitive_dependents
-  |]
-  execute [sql| DROP TABLE dependents_search_scope |]
-  execute [sql| DROP TABLE dependencies_query |]
-  pure . Map.fromList $ [(r, t) | r :. Only t <- result]
+  result0 :: [S.Reference.Id :. Only ObjectType] <-
+    queryListRow
+      [sql|
+        WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS (
+          SELECT d.dependent_object_id, d.dependent_component_index, object.type_id
+          FROM dependents_index d
+          JOIN object ON d.dependent_object_id = object.id
+          JOIN $queryTableName q
+            ON q.builtin IS d.dependency_builtin
+            AND q.object_id IS d.dependency_object_id
+            AND q.component_index IS d.dependency_component_index
+          JOIN $scopeTableName s
+            ON s.object_id = d.dependent_object_id
+            AND s.component_index = d.dependent_component_index
+
+          UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id
+          FROM dependents_index d
+          JOIN object ON d.dependent_object_id = object.id
+          JOIN transitive_dependents t
+            ON t.dependent_object_id = d.dependency_object_id
+            AND t.dependent_component_index = d.dependency_component_index
+          JOIN $scopeTableName s
+            ON s.object_id = d.dependent_object_id
+            AND s.component_index = d.dependent_component_index
+        )
+        SELECT * FROM transitive_dependents
+      |]
+
+  execute [sql| DROP TABLE $scopeTableName |]
+  execute [sql| DROP TABLE $queryTableName |]
+
+  -- Post-process the query result
+  let result1 =
+        List.foldl'
+          ( \deps -> \case
+              dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types
+              dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types)
+              _ -> deps -- impossible; could error here
+          )
+          (Defns Set.empty Set.empty)
+          result0
+
+  pure result1
+
+createTemporaryTableOfReferences :: Sql -> Set S.Reference -> Transaction ()
+createTemporaryTableOfReferences tableName refs = do
+  execute
+    [sql|
+      CREATE TEMPORARY TABLE $tableName (
+        builtin INTEGER NULL,
+        object_id INTEGER NULL,
+        component_index INTEGER NULL
+        CHECK ((builtin IS NULL) = (object_id IS NOT NULL)),
+        CHECK ((object_id IS NULL) = (component_index IS NULL))
+      )
+    |]
+
+  for_ refs \ref ->
+    execute [sql| INSERT INTO $tableName VALUES (@ref, @, @) |]
 
 createTemporaryTableOfReferenceIds :: Sql -> Set S.Reference.Id -> Transaction ()
 createTemporaryTableOfReferenceIds tableName refs = do
@@ -1996,6 +2068,8 @@ createTemporaryTableOfReferenceIds tableName refs = do
   for_ refs \ref ->
     execute [sql| INSERT INTO $tableName VALUES (@ref, @) |]
 
+{- ORMOLU_DISABLE -}
+
 objectIdByBase32Prefix :: ObjectType -> Text -> Transaction [ObjectId]
 objectIdByBase32Prefix objType prefix =
   queryListCol

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

@@ -6,6 +6,7 @@ where
 
 import Data.Set qualified as Set
 import U.Codebase.Sqlite.Operations qualified as Operations
+import Unison.Builtin qualified as Builtin
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli
@@ -14,9 +15,12 @@ import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Branch.Names qualified as Branch
 import Unison.Codebase.Editor.Output
-import Unison.Codebase.Editor.TodoOutput qualified as TO
 import Unison.Names qualified as Names
+import Unison.Prelude
+import Unison.Reference (TermReference)
+import Unison.Syntax.Name qualified as Name
 import Unison.Util.Defns (Defns (..))
+import Unison.Util.Set qualified as Set
 
 handleTodo :: Cli ()
 handleTodo = do
@@ -25,27 +29,42 @@ handleTodo = do
   currentNamespace <- Cli.getCurrentBranch0
   let currentNamespaceWithoutLibdeps = Branch.deleteLibdeps currentNamespace
 
-  (hashLen, directDependencies) <-
+  (dependentsOfTodo, directDependencies, hashLen) <-
     Cli.runTransaction do
-      hashLen <- Codebase.hashLength
+      let todoReference :: TermReference
+          todoReference =
+            Set.asSingleton (Names.refTermsNamed Builtin.names (Name.unsafeParseText "todo"))
+              & fromMaybe (error (reportBug "E260496" "No reference for builtin named 'todo'"))
+
+      -- All type-and-term dependents of the `todo` builtin, but we know they're all terms.
+      dependentsOfTodo <-
+        Operations.directDependentsWithinScope
+          (Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps)
+          (Set.singleton todoReference)
+
       directDependencies <-
         Operations.directDependenciesOfScope
           Defns
             { terms = Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps,
               types = Branch.deepTypeReferenceIds currentNamespaceWithoutLibdeps
             }
-      pure (hashLen, directDependencies)
 
-  let todo =
-        TO.TodoOutput
-          { directDependenciesWithoutNames =
-              Defns
-                { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace),
-                  types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace)
-                },
-            nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps)
-          }
+      hashLen <- Codebase.hashLength
+
+      pure (dependentsOfTodo.terms, directDependencies, hashLen)
 
-  pped <- Cli.currentPrettyPrintEnvDecl
+  ppe <- Cli.currentPrettyPrintEnvDecl
 
-  Cli.respondNumbered (TodoOutput hashLen pped todo)
+  Cli.respondNumbered $
+    Output'Todo
+      TodoOutput
+        { hashLen,
+          dependentsOfTodo,
+          directDependenciesWithoutNames =
+            Defns
+              { terms = Set.difference directDependencies.terms (Branch.deepTermReferences currentNamespace),
+                types = Set.difference directDependencies.types (Branch.deepTypeReferences currentNamespace)
+              },
+          nameConflicts = Names.conflicts (Branch.toNames currentNamespaceWithoutLibdeps),
+          ppe
+        }

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

@@ -511,17 +511,8 @@ getNamespaceDependentsOf ::
   Set Reference ->
   Transaction (DefnsF (Relation Name) TermReferenceId TypeReferenceId)
 getNamespaceDependentsOf names dependencies = do
-  dependents <- Ops.dependentsWithinScope (Names.referenceIds names) dependencies
-  let dependents1 :: DefnsF Set TermReferenceId TypeReferenceId
-      dependents1 =
-        Map.foldlWithKey'
-          ( \defns refId -> \case
-              Reference.RtTerm -> let !terms1 = Set.insert refId defns.terms in defns & #terms .~ terms1
-              Reference.RtType -> let !types1 = Set.insert refId defns.types in defns & #types .~ types1
-          )
-          (Defns Set.empty Set.empty)
-          dependents
-  pure (bimap (foldMap nameTerm) (foldMap nameType) dependents1)
+  dependents <- Ops.transitiveDependentsWithinScope (Names.referenceIds names) dependencies
+  pure (bimap (foldMap nameTerm) (foldMap nameType) dependents)
   where
     nameTerm :: TermReferenceId -> Relation Name TermReferenceId
     nameTerm ref =
@@ -542,26 +533,21 @@ getNamespaceDependentsOf2 defns dependencies = do
   let scope = bifoldMap toTermScope toTypeScope defns
 
   dependents <-
-    Ops.dependentsWithinScope scope dependencies
-
-  let (termDependentRefs, typeDependentRefs) =
-        dependents & Map.partition \case
-          Reference.RtTerm -> True
-          Reference.RtType -> False
+    Ops.transitiveDependentsWithinScope scope dependencies
 
   pure
     Defns
-      { terms = Map.foldlWithKey' addTerms Map.empty termDependentRefs,
-        types = Map.foldlWithKey' addTypes Map.empty typeDependentRefs
+      { terms = Set.foldl' addTerms Map.empty dependents.terms,
+        types = Set.foldl' addTypes Map.empty dependents.types
       }
   where
-    addTerms :: Map Name TermReferenceId -> TermReferenceId -> ignored -> Map Name TermReferenceId
-    addTerms acc0 ref _ =
+    addTerms :: Map Name TermReferenceId -> TermReferenceId -> Map Name TermReferenceId
+    addTerms acc0 ref =
       let names = BiMultimap.lookupDom (Referent.fromTermReferenceId ref) defns.terms
        in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names
 
-    addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> ignored -> Map Name TypeReferenceId
-    addTypes acc0 ref _ =
+    addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> Map Name TypeReferenceId
+    addTypes acc0 ref =
       let names = BiMultimap.lookupDom (Reference.fromId ref) defns.types
        in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names