Merge pull request #134 from unisoncomputing/narrow

feat: more efficient diffs

Author: ChrisPenner

.github/workflows/ci.yaml

@@ -238,7 +238,7 @@ jobs:
 
           # Install ucm
           mkdir ucm
-          curl -L https://github.com/unisonweb/unison/releases/download/release%2F0.5.44/ucm-linux-x64.tar.gz | tar -xz -C ucm
+          curl -L https://github.com/unisonweb/unison/releases/download/release%2F0.5.45/ucm-linux-x64.tar.gz | tar -xz -C ucm
           export PATH=$PWD/ucm:$PATH
 
           # Start share and it's dependencies in the background

src/Share/Backend.hs

@@ -41,7 +41,7 @@ import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Share.Codebase qualified as Codebase
 import Share.Codebase.CodeCache qualified as CC
-import Share.Codebase.Types (CodebaseRuntime (CodebaseRuntime, cachedEvalResult))
+import Share.Codebase.Types (CodeCache, CodebaseRuntime (CodebaseRuntime, cachedEvalResult))
 import Share.Postgres (QueryM)
 import Share.Postgres qualified as PG
 import Share.Postgres.Causal.Conversions (namespaceStatsPgToV2)
@@ -69,7 +69,7 @@ import Unison.NameSegment.Internal (NameSegment (..))
 import Unison.Parser.Ann (Ann)
 import Unison.PrettyPrintEnv qualified as PPE
 import Unison.PrettyPrintEnvDecl qualified as PPED
-import Unison.Reference (Reference)
+import Unison.Reference (Reference, TermReference, TypeReference)
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
 import Unison.Runtime.IOSource qualified as DD
@@ -248,8 +248,13 @@ getTypeTagsOf trav s = do
         Just CT.Data -> Data
         Just CT.Effect -> Ability
 
-displayTermsOf :: (QueryM m) => Codebase.CodebaseEnv -> Traversal s t Reference (DisplayObject (Type Symbol Ann) (V1.Term Symbol Ann)) -> s -> m t
-displayTermsOf codebase trav s =
+displayTermsOf ::
+  (QueryM m) =>
+  CodeCache scope ->
+  Traversal s t TermReference (DisplayObject (Type Symbol Ann) (V1.Term Symbol Ann)) ->
+  s ->
+  m t
+displayTermsOf codeCache trav s =
   s
     & asListOfDeduped trav %%~ \refs -> do
       let partitionedRefs =
@@ -261,7 +266,7 @@ displayTermsOf codebase trav s =
                   Nothing -> Left $ MissingObject $ Reference.toShortHash ref
                   Just typ -> Left $ BuiltinObject (mempty <$ typ)
               Reference.DerivedId rid -> Right rid
-      r <- Codebase.expectTermsByRefIdsOf codebase (traversed . _Right) partitionedRefs
+      r <- CC.expectTermsAndTypesByRefIdsOf codeCache (traversed . _Right) partitionedRefs
       r
         & traversed
           %~ \case
@@ -272,15 +277,15 @@ displayTermsOf codebase trav s =
             Left obj -> obj
         & pure
 
-displayTypesOf :: (QueryM m) => Codebase.CodebaseEnv -> Traversal s t Reference (DisplayObject () (DD.Decl Symbol Ann)) -> s -> m t
-displayTypesOf codebase trav s =
+displayTypesOf :: (QueryM m) => CodeCache scope -> Traversal s t TypeReference (DisplayObject () (DD.Decl Symbol Ann)) -> s -> m t
+displayTypesOf codeCache trav s =
   s
     & asListOf trav %%~ \refs -> do
       let partitionedRefs =
             refs <&> \case
               Reference.Builtin _ -> Left (BuiltinObject ())
               Reference.DerivedId rid -> Right rid
-      Codebase.expectTypeDeclarationsByRefIdsOf codebase (traversed . _Right) partitionedRefs
+      CC.expectTypeDeclsByRefIdsOf codeCache (traversed . _Right) partitionedRefs
         <&> fmap \case
           Left obj -> obj
           Right decl -> (UserObject decl)

src/Share/BackgroundJobs/Search/DefinitionSync.hs

@@ -22,6 +22,8 @@ import Share.BackgroundJobs.Monad (Background)
 import Share.BackgroundJobs.Search.DefinitionSync.Types (Arity (..), DefinitionDocument (..), DefnSearchToken (..), Occurrence, OccurrenceKind (..), TermOrTypeSummary (..), TermOrTypeTag (..), VarId (..))
 import Share.BackgroundJobs.Workers (newWorker)
 import Share.Codebase qualified as Codebase
+import Share.Codebase.CodeCache qualified as CodeCache
+import Share.Codebase.Types (CodeCache)
 import Share.IDs (ReleaseId, UserId)
 import Share.Metrics qualified as Metrics
 import Share.Postgres qualified as PG
@@ -165,12 +167,13 @@ syncRoot authZReceipt (mayReleaseId, rootBranchHashId, codebaseOwner) = do
         let nlReceipt = nameLookupReceipt namesPerspective
         let codebaseLoc = Codebase.codebaseLocationForProjectRelease codebaseOwner
         let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
-        termsCursor <- NLOps.projectTermsWithinRoot nlReceipt rootBranchHashId
+        CodeCache.withCodeCache codebase \codeCache -> do
+          termsCursor <- NLOps.projectTermsWithinRoot nlReceipt rootBranchHashId
 
-        termErrs <- syncTerms codebase namesPerspective rootBranchHashId termsCursor
-        typesCursor <- NLOps.projectTypesWithinRoot nlReceipt rootBranchHashId
-        typeErrs <- syncTypes codebase namesPerspective rootBranchHashId typesCursor
-        pure (termErrs <> typeErrs)
+          termErrs <- syncTerms codebase namesPerspective rootBranchHashId termsCursor
+          typesCursor <- NLOps.projectTypesWithinRoot nlReceipt rootBranchHashId
+          typeErrs <- syncTypes codebase codeCache namesPerspective rootBranchHashId typesCursor
+          pure (termErrs <> typeErrs)
       True -> pure mempty
   -- Copy relevant index rows into the global search index as well
   for mayReleaseId (syncRelease rootBranchHashId)
@@ -377,11 +380,12 @@ typeSigTokens typ =
 syncTypes ::
   (PG.QueryM m) =>
   Codebase.CodebaseEnv ->
+  CodeCache scope ->
   NamesPerspective m ->
   BranchHashId ->
   Cursors.PGCursor (Name, TypeReference) ->
   m ([DefnIndexingFailure], [Text])
-syncTypes codebase namesPerspective rootBranchHashId typesCursor = do
+syncTypes codebase codeCache namesPerspective rootBranchHashId typesCursor = do
   Cursors.foldBatched typesCursor defnBatchSize \types -> do
     let nonLibTypes =
           types
@@ -408,7 +412,7 @@ syncTypes codebase namesPerspective rootBranchHashId typesCursor = do
         <&> V.unzip3
     let basicTokens = Data.zipWith2 fqns refs \fqn ref -> Set.fromList [NameToken fqn, HashToken $ Reference.toShortHash ref]
     let allTokens = Data.zipWith2 declTokens basicTokens Set.union
-    typeSummaries <- Summary.typeSummariesForReferencesOf codebase Nothing traversed (Data.zip2 refs (Just <$> fqns))
+    typeSummaries <- Summary.typeSummariesForReferencesOf codeCache Nothing traversed (Data.zip2 refs (Just <$> fqns))
     let defDocuments = Data.zipWith5 refs fqns typeSummaries allTokens arities $ \ref fqn typeSummary tokens arity ->
           let sh = Reference.toShortHash ref
            in DefinitionDocument

src/Share/Codebase.hs

@@ -7,6 +7,7 @@ module Share.Codebase
   ( shorthashLength,
     CodebaseEnv,
     codebaseOwner,
+    CodebaseError (..),
     CodebaseRuntime (..),
     codebaseEnv,
     codebaseForProjectBranch,

src/Share/Codebase/CodeCache.hs

@@ -6,7 +6,9 @@ module Share.Codebase.CodeCache
     termsForRefsOf,
     typesOfReferentsOf,
     getTermsAndTypesByRefIdsOf,
+    expectTermsAndTypesByRefIdsOf,
     getTypeDeclsByRefIdsOf,
+    expectTypeDeclsByRefIdsOf,
     getTypeDeclsByRefsOf,
     cacheTermAndTypes,
     cacheDecls,
@@ -34,6 +36,7 @@ import Unison.DataDeclaration qualified as V1
 import Unison.DataDeclaration.ConstructorId qualified as V1Decl
 import Unison.Hash (Hash)
 import Unison.Parser.Ann
+import Unison.Reference (TermReferenceId, TypeReferenceId)
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as V1Referent
 import Unison.Runtime.IOSource qualified as IOSource
@@ -43,6 +46,9 @@ import Unison.Term qualified as V1
 import Unison.Type qualified as Type
 import Unison.Type qualified as V1
 
+type TermAndType =
+  (V1.Term Symbol Ann, V1.Type Symbol Ann)
+
 withCodeCache :: (QueryM m) => CodebaseEnv -> (forall s. CodeCache s -> m r) -> m r
 withCodeCache codeCacheCodebaseEnv action = do
   codeCacheVar <- PG.transactionUnsafeIO (newTVarIO (CodeCacheData Map.empty Map.empty))
@@ -52,30 +58,24 @@ withCodeCache codeCacheCodebaseEnv action = do
 readCodeCache :: (QueryM m) => CodeCache s -> m CodeCacheData
 readCodeCache CodeCache {codeCacheVar} = PG.transactionUnsafeIO (readTVarIO codeCacheVar)
 
-cacheTermAndTypes ::
-  (QueryM m) =>
-  CodeCache s ->
-  [(Reference.Id, (V1.Term Symbol Ann, V1.Type Symbol Ann))] ->
-  m ()
+cacheTermAndTypes :: (QueryM m) => CodeCache s -> Map TermReferenceId TermAndType -> m ()
 cacheTermAndTypes CodeCache {codeCacheVar} termAndTypes = do
   PG.transactionUnsafeIO do
     atomically do
       modifyTVar' codeCacheVar \CodeCacheData {termCache, ..} ->
-        let newTermMap = Map.fromList termAndTypes
-            termCache' = Map.union termCache newTermMap
+        let !termCache' = Map.union termCache termAndTypes
          in CodeCacheData {termCache = termCache', ..}
 
 cacheDecls ::
   (QueryM m) =>
   CodeCache s ->
-  [(Reference.Id, V1.Decl Symbol Ann)] ->
+  Map TypeReferenceId (V1.Decl Symbol Ann) ->
   m ()
 cacheDecls CodeCache {codeCacheVar} decls = do
   PG.transactionUnsafeIO do
     atomically do
       modifyTVar' codeCacheVar \CodeCacheData {typeCache, ..} ->
-        let newDeclsMap = Map.fromList decls
-            typeCache' = Map.union typeCache newDeclsMap
+        let !typeCache' = Map.union typeCache decls
          in CodeCacheData {typeCache = typeCache', ..}
 
 builtinsCodeLookup :: (Monad m) => CL.CodeLookup Symbol m Ann
@@ -97,7 +97,7 @@ toCodeLookup codeCache = do
 getTermsAndTypesByRefIdsOf ::
   (QueryM m) =>
   CodeCache scope ->
-  Traversal s t Reference.Id (Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann)) ->
+  Traversal s t TermReferenceId (Maybe TermAndType) ->
   s ->
   m t
 getTermsAndTypesByRefIdsOf codeCache@(CodeCache {codeCacheCodebaseEnv}) trav s = do
@@ -123,19 +123,34 @@ getTermsAndTypesByRefIdsOf codeCache@(CodeCache {codeCacheCodebaseEnv}) trav s =
                     Nothing -> (mempty, Nothing)
                 Right tt -> (mempty, Just tt)
 
-      cacheTermAndTypes codeCache cacheable
-      pure $ hydrated'
-  where
-    findBuiltinTT :: Reference.Id -> Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann)
-    findBuiltinTT refId = do
-      tm <- runIdentity $ CL.getTerm builtinsCodeLookup refId
-      typ <- runIdentity $ CL.getTypeOfTerm builtinsCodeLookup refId
-      pure (tm, typ)
+      cacheTermAndTypes codeCache (Map.fromList cacheable)
+      pure hydrated'
+
+-- | Like 'getTermsAndTypesByRefIdsOf', but throws an unrecoverable error when the term isn't in the database.
+expectTermsAndTypesByRefIdsOf ::
+  forall m scope s t.
+  (QueryM m) =>
+  CodeCache scope ->
+  Traversal s t TermReferenceId TermAndType ->
+  s ->
+  m t
+expectTermsAndTypesByRefIdsOf codeCache trav =
+  asListOf trav %%~ \refs -> do
+    termsAndTypes <- getTermsAndTypesByRefIdsOf codeCache traverse refs
+    for (zip refs termsAndTypes) \case
+      (_, Just tt) -> pure tt
+      (ref, Nothing) -> PG.unrecoverableError (Codebase.MissingTerm ref)
+
+findBuiltinTT :: TermReferenceId -> Maybe TermAndType
+findBuiltinTT refId = do
+  tm <- runIdentity $ CL.getTerm builtinsCodeLookup refId
+  typ <- runIdentity $ CL.getTypeOfTerm builtinsCodeLookup refId
+  pure (tm, typ)
 
 getTypeDeclsByRefIdsOf ::
   (QueryM m) =>
   CodeCache scope ->
-  Traversal s t Reference.Id (Maybe (V1.Decl Symbol Ann)) ->
+  Traversal s t TypeReferenceId (Maybe (V1.Decl Symbol Ann)) ->
   s ->
   m t
 getTypeDeclsByRefIdsOf codeCache@(CodeCache {codeCacheCodebaseEnv}) trav s = do
@@ -161,12 +176,25 @@ getTypeDeclsByRefIdsOf codeCache@(CodeCache {codeCacheCodebaseEnv}) trav s = do
                     Nothing -> (mempty, Nothing)
                 Right decl -> (mempty, Just decl)
 
-      cacheDecls codeCache cacheable
-      pure $ hydrated'
-  where
-    findBuiltinDecl :: Reference.Id -> Maybe (V1.Decl Symbol Ann)
-    findBuiltinDecl refId = do
-      runIdentity $ CL.getTypeDeclaration builtinsCodeLookup refId
+      cacheDecls codeCache (Map.fromList cacheable)
+      pure hydrated'
+
+expectTypeDeclsByRefIdsOf ::
+  (QueryM m) =>
+  CodeCache scope ->
+  Traversal s t TypeReferenceId (V1.Decl Symbol Ann) ->
+  s ->
+  m t
+expectTypeDeclsByRefIdsOf codeCache trav =
+  asListOf trav %%~ \refs -> do
+    decls <- getTypeDeclsByRefIdsOf codeCache traverse refs
+    for (zip refs decls) \case
+      (_, Just decl) -> pure decl
+      (ref, Nothing) -> PG.unrecoverableError (Codebase.MissingDecl ref)
+
+findBuiltinDecl :: Reference.Id -> Maybe (V1.Decl Symbol Ann)
+findBuiltinDecl refId = do
+  runIdentity $ CL.getTypeDeclaration builtinsCodeLookup refId
 
 getTypeDeclsByRefsOf ::
   (QueryM m) =>
@@ -196,7 +224,7 @@ termsForRefsOf codeCache trav s = do
   s
     & asListOf trav %%~ \refs ->
       do
-        let trav :: Traversal Reference (Maybe (V1.Term Symbol ())) Reference.Id (Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann))
+        let trav :: Traversal Reference (Maybe (V1.Term Symbol ())) Reference.Id (Maybe TermAndType)
             trav f = \case
               -- Builtins are their own terms
               ref@(Reference.Builtin _) -> pure (Just (Term.ref () ref))
@@ -241,7 +269,7 @@ typesOfReferentsOf codeCache trav s = do
         [ Either
             (V1.Type Symbol ())
             ( Either
-                (Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann))
+                (Maybe TermAndType)
                 (Reference.Id' Hash, V1Decl.ConstructorId)
             )
         ] <-
@@ -250,7 +278,7 @@ typesOfReferentsOf codeCache trav s = do
         [ Either
             (V1.Type Symbol ())
             ( Either
-                (Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann))
+                (Maybe TermAndType)
                 (Maybe (V1.Decl Symbol Ann), V1Decl.ConstructorId)
             )
         ] <-

src/Share/Codebase/Types.hs

@@ -21,6 +21,7 @@ import Unison.Codebase.Runtime qualified as Rt
 import Unison.DataDeclaration qualified as V1
 import Unison.NameSegment.Internal (NameSegment (..))
 import Unison.Parser.Ann (Ann)
+import Unison.Reference (TermReferenceId, TypeReferenceId)
 import Unison.Reference qualified as Reference
 import Unison.Symbol (Symbol)
 import Unison.Term qualified as V1
@@ -31,18 +32,21 @@ publicRoot :: Path.Path
 publicRoot = Path.singleton (NameSegment "public")
 
 -- | The scope of a given codebase transaction.
+--
+-- If two @CodebaseEnv@ are equal, they correspond to the same codebase.
 data CodebaseEnv = CodebaseEnv
   { codebaseOwner :: UserId
   }
+  deriving stock (Eq)
 
 data CodeCache scope = CodeCache
   { codeCacheCodebaseEnv :: CodebaseEnv,
     codeCacheVar :: TVar CodeCacheData
   }
 
 data CodeCacheData = CodeCacheData
-  { termCache :: Map Reference.Id (V1.Term Symbol Ann, V1.Type Symbol Ann),
-    typeCache :: Map Reference.Id (V1.Decl Symbol Ann)
+  { termCache :: Map TermReferenceId (V1.Term Symbol Ann, V1.Type Symbol Ann),
+    typeCache :: Map TypeReferenceId (V1.Decl Symbol Ann)
   }
 
 -- | The runtime environment for a codebase transaction.