talking and pairing and pairing and talking

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

@@ -65,6 +65,7 @@ module U.Codebase.Sqlite.Operations
     -- ** dependents index
     dependents,
     dependentsOfComponent,
+    dependentsWithinScope,
 
     -- ** type index
     Q.addTypeToIndexForTerm,
@@ -545,7 +546,6 @@ expectDeclNumConstructors (C.Reference.Id h i) = do
   oid <- Q.expectObjectIdForPrimaryHash h
   Q.expectDeclObject oid (decodeDeclElementNumConstructors i)
 
-
 -- * Branch transformation
 
 s2cBranch :: S.DbBranch -> Transaction (C.Branch.Branch Transaction)
@@ -1142,6 +1142,20 @@ 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"
+
 -- | returns a list of known definitions referencing `h`
 dependentsOfComponent :: H.Hash -> Transaction (Set C.Reference.Id)
 dependentsOfComponent h = do

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

@@ -160,6 +160,7 @@ module U.Codebase.Sqlite.Queries
     getDependenciesForDependent,
     getDependencyIdsForDependent,
     getDependenciesBetweenTerms,
+    getDependentsWithinScope,
 
     -- ** type index
     addToTypeIndex,
@@ -1775,6 +1776,83 @@ getDependenciesBetweenTerms oid1 oid2 =
       WHERE path_elem IS NOT null
     |]
 
+-- | `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 Reference.Id -> Set S.Reference -> Transaction (Map Reference.Id ObjectType)
+getDependentsWithinScope scope query = do
+  -- Populate a temporary table with all of the references in `scope`
+  execute
+    [sql|
+      CREATE TEMPORARY TABLE dependents_search_scope (
+        dependent_object_id INTEGER NOT NULL,
+        dependent_component_index INTEGER NOT NULL,
+        PRIMARY KEY (dependent_object_id, dependent_component_index)
+      )
+    |]
+  for_ scope \r ->
+    execute [sql|INSERT INTO dependents_search_scope VALUES (@r, @)|]
+
+  -- 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, @, @)|]
+
+  -- Say the query set is { #foo, #bar }, and the scope set is { #foo, #bar, #baz, #qux, #honk }.
+  --
+  -- Furthermore, say the dependencies are as follows, where `x -> y` means "x depends on y".
+  --
+  --   #honk -> #baz -> #foo
+  --            #qux -> #bar
+  --
+  -- The recursive query below is seeded with direct dependents of the `query` set that are in `scope`, namely:
+  --
+  --   #honk -> #baz -> #foo
+  --            #qux -> #bar
+  --            ^^^^
+  --            direct deps of { #foo, #bar } are: { #baz, #qux }
+  --
+  -- Then, every iteration of the query expands to that set's dependents (#honk and onwards), until there are no more.
+  -- We use `UNION` rather than `UNION ALL` so as to not track down the transitive dependents of any particular
+  -- reference more than once.
+
+  result :: [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.dependent_object_id = d.dependent_object_id
+        AND s.dependent_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.dependent_object_id = d.dependent_object_id
+        AND s.dependent_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]
+
 objectIdByBase32Prefix :: ObjectType -> Text -> Transaction [ObjectId]
 objectIdByBase32Prefix objType prefix =
   queryListCol

codebase2/core/U/Codebase/Reference.hs

@@ -10,6 +10,7 @@ module U.Codebase.Reference
     Reference' (..),
     TermReference',
     TypeReference',
+    ReferenceType(..),
     pattern Derived,
     Id,
     Id' (..),
@@ -34,11 +35,11 @@ import Data.Bifoldable (Bifoldable (..))
 import Data.Bitraversable (Bitraversable (..))
 import Data.Text qualified as Text
 import Unison.Hash (Hash)
+import Unison.Hash qualified as H
 import Unison.Hash qualified as Hash
 import Unison.Prelude
 import Unison.ShortHash (ShortHash)
 import Unison.ShortHash qualified as SH
-import Unison.Hash qualified as H
 
 -- | This is the canonical representation of Reference
 type Reference = Reference' Text Hash
@@ -66,6 +67,8 @@ type TermReferenceId = Id
 -- | A type declaration reference id.
 type TypeReferenceId = Id
 
+data ReferenceType = RtTerm | RtType deriving (Eq, Ord, Show)
+
 -- | Either a builtin or a user defined (hashed) top-level declaration. Used for both terms and types.
 data Reference' t h
   = ReferenceBuiltin t
@@ -163,4 +166,3 @@ component :: H.Hash -> [k] -> [(k, Id)]
 component h ks =
   let
    in [(k, (Id h i)) | (k, i) <- ks `zip` [0 ..]]
-

unison-cli/package.yaml

@@ -61,6 +61,7 @@ dependencies:
   - recover-rtti
   - regex-tdfa
   - semialign
+  - semigroups
   - servant
   - servant-client
   - stm

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

@@ -84,6 +84,7 @@ import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft)
 import Unison.Codebase.Editor.HandleInput.TermResolution (resolveCon, resolveMainRef, resolveTermRef)
 import Unison.Codebase.Editor.HandleInput.UI (openUI)
 import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds, handleUpdate)
+import Unison.Codebase.Editor.HandleInput.Update2 (handleUpdate2)
 import Unison.Codebase.Editor.Input
 import Unison.Codebase.Editor.Input qualified as Input
 import Unison.Codebase.Editor.Output
@@ -1111,6 +1112,7 @@ loop e = do
               let sr = Slurp.slurpFile uf vars Slurp.AddOp currentNames
               previewResponse sourceName sr uf
             UpdateI optionalPatch requestedNames -> handleUpdate input optionalPatch requestedNames
+            Update2I -> handleUpdate2
             PreviewUpdateI requestedNames -> do
               (sourceName, _) <- Cli.expectLatestFile
               uf <- Cli.expectLatestTypecheckedFile

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

@@ -0,0 +1,84 @@
+module Unison.Codebase.Editor.HandleInput.Update
+  ( handleUpdate2,
+  )
+where
+
+import U.Codebase.Reference (Reference, ReferenceType)
+import U.Codebase.Reference qualified as Reference
+import U.Codebase.Sqlite.Operations qualified as Ops
+import Unison.Cli.Monad (Cli)
+import Unison.Cli.MonadUtils qualified as Cli
+import Unison.Cli.NamesUtils qualified as NamesUtils
+import Unison.Codebase qualified as Codebase
+import Unison.Name (Name)
+import Unison.Names (Names)
+import Unison.NamesWithHistory qualified as NamesWithHistory
+import Unison.Parser.Ann (Ann)
+import Unison.Prelude
+import Unison.PrettyPrintEnvDecl.Names qualified as PPE
+import Unison.Symbol (Symbol)
+import Unison.UnisonFile.Type (TypecheckedUnisonFile, UnisonFile)
+
+data Defns terms types = Defns
+  { terms :: !terms,
+    types :: !types
+  }
+  deriving stock (Generic, Show)
+
+-- deriving (Semigroup) via GenericSemigroupMonoid (Defns terms types)
+
+handleUpdate2 :: Cli ()
+handleUpdate2 = do
+  -- - confirm all aliases updated together?
+  tuf <- Cli.expectLatestTypecheckedFile
+
+  -- - get add/updates from TUF
+  let termAndDeclNames :: Defns (Set Name) (Set Name) = getTermAndDeclNames tuf
+  -- - construct new UF with dependents
+  names :: Names <- NamesUtils.getBasicPrettyPrintNames
+
+  dependents :: Map Reference.Id ReferenceType <- Ops.dependentsWithinScope <$> namespaceReferences names <*> getExistingReferencesNamed termAndDeclNames names
+  bigUf <- buildBigUnisonFile tuf dependents names
+  -- - construct PPE for printing UF* for typechecking (whatever data structure we decide to print)
+  ppe <- Codebase.hashLength <&> (`PPE.fromNamesDecl` (NamesWithHistory.fromCurrentNames names))
+  -- - typecheck it
+  typecheckBigUf bigUf >>= \case
+    Left bigUfText -> prependTextToScratchFile bigUfText
+    Right tuf -> saveTuf tuf
+
+-- travis
+prependTextToScratchFile :: Text -> Cli a0
+prependTextToScratchFile bigUfText = wundefined
+
+typecheckBigUf :: UnisonFile v a -> Cli (Either Text (TypecheckedUnisonFile v a))
+typecheckBigUf = wundefined
+
+-- save definitions and namespace
+saveTuf :: TypecheckedUnisonFile v a -> Cli a0
+saveTuf = wundefined
+
+-- arya
+getExistingReferencesNamed :: Defns (Set Name) (Set Name) -> Names -> Cli (Set Reference)
+getExistingReferencesNamed = wundefined
+
+-- mitchell
+buildBigUnisonFile :: TypecheckedUnisonFile Symbol Ann -> Map Reference.Id Reference.ReferenceType -> Names -> Cli a0
+buildBigUnisonFile = wundefined
+
+namespaceReferences :: Names -> Cli (Set Reference.Id)
+namespaceReferences = wundefined
+
+getExistingReferences :: Defns (Set Name) (Set Name) -> Cli (Set Reference)
+getExistingReferences = wundefined
+
+getTermAndDeclNames :: TypecheckedUnisonFile v a -> Defns (Set Name) (Set Name)
+getTermAndDeclNames = wundefined
+
+-- namespace:
+-- type Foo = Bar Nat
+-- baz = 4
+-- qux = baz + 1
+
+-- unison file:
+-- Foo.Bar = 3
+-- baz = 5

unison-cli/src/Unison/Codebase/Editor/Input.hs

@@ -150,6 +150,7 @@ data Input
   | AddI (Set Name)
   | PreviewAddI (Set Name)
   | UpdateI OptionalPatch (Set Name)
+  | Update2I
   | PreviewUpdateI (Set Name)
   | TodoI (Maybe PatchPath) Path'
   | PropagatePatchI PatchPath Path'

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -1553,6 +1553,20 @@ mergeLocal =
         _ -> Nothing
     )
 
+update2 :: InputPattern
+update2 =
+  InputPattern
+    { patternName = "update2",
+      aliases = [],
+      visibility = I.Visible,
+      argTypes = [],
+      help = P.wrap (makeExample update2 []),
+      parse =
+        maybeToEither (I.help update2) . \case
+          [] -> Just Input.Update2I
+          _ -> Nothing
+    }
+
 parseLooseCodeOrProject :: String -> Maybe Input.LooseCodeOrProject
 parseLooseCodeOrProject inputString =
   case (asLooseCode, asBranch) of
@@ -2898,6 +2912,7 @@ validInputs =
       unlink,
       up,
       update,
+      update2,
       updateBuiltins,
       updateNoPatch,
       view,