Add entity count when loading dependencies

Author: ChrisPenner

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

@@ -686,7 +686,7 @@ saveObject ::
   ObjectType ->
   ByteString ->
   Transaction ObjectId
-saveObject hh h t blob = do
+saveObject _hh h t blob = do
   execute
     [sql|
       INSERT INTO object (primary_hash_id, type_id, bytes)
@@ -695,11 +695,11 @@ saveObject hh h t blob = do
     |]
   oId <- expectObjectIdForPrimaryHashId h
   saveHashObject h oId 2 -- todo: remove this from here, and add it to other relevant places once there are v1 and v2 hashes
-  rowsModified >>= \case
-    0 -> pure ()
-    _ -> do
-      hash <- expectHash32 h
-      tryMoveTempEntityDependents hh hash
+  -- rowsModified >>= \case
+  --   0 -> pure ()
+  --   _ -> do
+  --     hash <- expectHash32 h
+  --     tryMoveTempEntityDependents hh hash
   pure oId
 
 expectObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a
@@ -957,7 +957,7 @@ saveCausal ::
   BranchHashId ->
   [CausalHashId] ->
   Transaction ()
-saveCausal hh self value parents = do
+saveCausal _hh self value parents = do
   execute
     [sql|
       INSERT INTO causal (self_hash_id, value_hash_id)
@@ -973,13 +973,13 @@ saveCausal hh self value parents = do
             INSERT INTO causal_parent (causal_id, parent_id)
             VALUES (:self, :parent)
           |]
-      flushCausalDependents hh self
+      -- flushCausalDependents hh self
 
-flushCausalDependents ::
+_flushCausalDependents ::
   HashHandle ->
   CausalHashId ->
   Transaction ()
-flushCausalDependents hh chId = do
+_flushCausalDependents hh chId = do
   hash <- expectHash32 (unCausalHashId chId)
   tryMoveTempEntityDependents hh hash
 

unison-cli/src/Unison/Share/SyncV2.hs

@@ -26,6 +26,7 @@ import Data.Conduit.Zlib qualified as C
 import Data.Graph qualified as Graph
 import Data.Map qualified as Map
 import Data.Set qualified as Set
+import Data.Text.IO qualified as Text
 import Servant.Conduit ()
 import System.Console.Regions qualified as Console.Regions
 import U.Codebase.HashTags (CausalHash)
@@ -217,7 +218,9 @@ withEntityStream ::
   (Int -> Stream () SyncV2.DownloadEntitiesChunk -> m r) ->
   m r
 withEntityStream conn rootHash mayBranchRef callback = do
-  entities <- liftIO $ Sqlite.runTransaction conn (depsForCausal rootHash)
+  entities <- liftIO $ withEntityLoadingCallback $ \counter -> do
+    Sqlite.runTransaction conn (depsForCausal rootHash counter)
+  liftIO $ Text.hPutStrLn IO.stderr $ "Finished loading entities, writing sync-file."
   let totalEntities = fromIntegral $ Map.size entities
   let initialChunk =
         SyncV2.InitialC
@@ -256,8 +259,8 @@ syncToFile codebase rootHash mayBranchRef destFilePath = do
           C.runConduit $ stream C..| countC C..| C.map (BL.toStrict . CBOR.serialise) C..| C.transPipe liftIO C.gzip C..| C.sinkFile destFilePath
 
 -- | Collect all dependencies of a given causal hash.
-depsForCausal :: CausalHash -> Sqlite.Transaction (Map Hash32 (Sync.Entity Text Hash32 Hash32))
-depsForCausal causalHash = do
+depsForCausal :: CausalHash -> (Int -> IO ()) -> Sqlite.Transaction (Map Hash32 (Sync.Entity Text Hash32 Hash32))
+depsForCausal causalHash counter = do
   flip execStateT mempty $ expandEntities (causalHashToHash32 causalHash)
   where
     expandEntities :: Hash32 -> ((StateT (Map Hash32 (Sync.Entity Text Hash32 Hash32)) Sqlite.Transaction)) ()
@@ -267,6 +270,7 @@ depsForCausal causalHash = do
         False -> do
           entity <- lift $ Sync.expectEntity hash32
           modify (Map.insert hash32 entity)
+          lift . Sqlite.unsafeIO $ counter 1
           traverseOf_ Sync.entityHashes_ expandEntities entity
 
 -- | Gets the framed chunks from a NetString framed stream.
@@ -374,3 +378,18 @@ withStreamProgressCallback total action = do
         toIO $ action $ C.awaitForever \i -> do
           liftIO $ IO.atomically (IO.modifyTVar' entitiesDownloadedVar (+ 1))
           C.yield i
+
+withEntityLoadingCallback :: (MonadUnliftIO m) => ((Int -> m ()) -> m a) -> m a
+withEntityLoadingCallback action = do
+  counterVar <- IO.newTVarIO (0 :: Int)
+  IO.withRunInIO \toIO -> do
+    Console.Regions.displayConsoleRegions do
+      Console.Regions.withConsoleRegion Console.Regions.Linear \region -> do
+        Console.Regions.setConsoleRegion region do
+          processed <- IO.readTVar counterVar
+          pure $
+            "\n  Loading "
+              <> tShow processed
+              <> " entities...\n\n"
+        toIO $ action $ \i -> do
+          liftIO $ IO.atomically (IO.modifyTVar' counterVar (+ i))