[WIP] SyncV3

codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Format.hs

@@ -4,9 +4,18 @@ module U.Codebase.Sqlite.Branch.Format
     HashBranchFormat,
     BranchLocalIds,
     BranchLocalIds' (..),
+    branchLocalIdsText_,
+    branchLocalIdsDefn_,
+    branchLocalIdsPatch_,
+    branchLocalIdsChildren_,
     HashBranchLocalIds,
     SyncBranchFormat,
     SyncBranchFormat' (..),
+    syncBranchFormatTexts_,
+    syncBranchFormatDefns_,
+    syncBranchFormatPatches_,
+    syncBranchFormatChildren_,
+    syncBranchFormatParents_,
     LocalBranchBytes (..),
     localToDbBranch,
     localToDbDiff,
@@ -16,6 +25,7 @@ module U.Codebase.Sqlite.Branch.Format
   )
 where
 
+import Control.Lens
 import Data.Vector (Vector)
 import Data.Vector qualified as Vector
 import U.Codebase.HashTags
@@ -103,6 +113,18 @@ data BranchLocalIds' t d p c = LocalIds
   }
   deriving (Show, Eq)
 
+branchLocalIdsText_ :: Traversal (BranchLocalIds' t d p c) (BranchLocalIds' t' d p c) t t'
+branchLocalIdsText_ f (LocalIds t d p c) = LocalIds <$> traverse f t <*> pure d <*> pure p <*> pure c
+
+branchLocalIdsDefn_ :: Traversal (BranchLocalIds' t d p c) (BranchLocalIds' t d' p c) d d'
+branchLocalIdsDefn_ f (LocalIds t d p c) = LocalIds <$> pure t <*> traverse f d <*> pure p <*> pure c
+
+branchLocalIdsPatch_ :: Traversal (BranchLocalIds' t d p c) (BranchLocalIds' t d p' c) p p'
+branchLocalIdsPatch_ f (LocalIds t d p c) = LocalIds <$> pure t <*> pure d <*> traverse f p <*> pure c
+
+branchLocalIdsChildren_ :: Traversal (BranchLocalIds' t d p c) (BranchLocalIds' t d p c') c c'
+branchLocalIdsChildren_ f (LocalIds t d p c) = LocalIds <$> pure t <*> pure d <*> pure p <*> traverse f c
+
 -- | Bytes encoding a LocalBranch
 newtype LocalBranchBytes = LocalBranchBytes ByteString
   deriving (Show, Eq, Ord)
@@ -112,6 +134,31 @@ data SyncBranchFormat' parent text defn patch child
   | SyncDiff parent (BranchLocalIds' text defn patch child) LocalBranchBytes
   deriving (Eq, Show)
 
+syncBranchFormatTexts_ :: Traversal (SyncBranchFormat' parent text defn patch child) (SyncBranchFormat' parent text' defn patch child) text text'
+syncBranchFormatTexts_ f = \case
+  SyncFull li bytes -> SyncFull <$> (li & branchLocalIdsText_ %%~ f) <*> pure bytes
+  SyncDiff parent li bytes -> SyncDiff parent <$> (li & branchLocalIdsText_ %%~ f) <*> pure bytes
+
+syncBranchFormatDefns_ :: Traversal (SyncBranchFormat' parent text defn patch child) (SyncBranchFormat' parent text defn' patch child) defn defn'
+syncBranchFormatDefns_ f = \case
+  SyncFull li bytes -> SyncFull <$> (li & branchLocalIdsDefn_ %%~ f) <*> pure bytes
+  SyncDiff parent li bytes -> SyncDiff parent <$> (li & branchLocalIdsDefn_ %%~ f) <*> pure bytes
+
+syncBranchFormatPatches_ :: Traversal (SyncBranchFormat' parent text defn patch child) (SyncBranchFormat' parent text defn patch' child) patch patch'
+syncBranchFormatPatches_ f = \case
+  SyncFull li bytes -> SyncFull <$> (li & branchLocalIdsPatch_ %%~ f) <*> pure bytes
+  SyncDiff parent li bytes -> SyncDiff parent <$> (li & branchLocalIdsPatch_ %%~ f) <*> pure bytes
+
+syncBranchFormatChildren_ :: Traversal (SyncBranchFormat' parent text defn patch child) (SyncBranchFormat' parent text defn patch child') child child'
+syncBranchFormatChildren_ f = \case
+  SyncFull li bytes -> SyncFull <$> (li & branchLocalIdsChildren_ %%~ f) <*> pure bytes
+  SyncDiff parent li bytes -> SyncDiff parent <$> (li & branchLocalIdsChildren_ %%~ f) <*> pure bytes
+
+syncBranchFormatParents_ :: Traversal (SyncBranchFormat' parent text defn patch child) (SyncBranchFormat' parent' text defn patch child) parent parent'
+syncBranchFormatParents_ f = \case
+  SyncFull li bytes -> pure $ SyncFull li bytes
+  SyncDiff parent li bytes -> SyncDiff <$> f parent <*> pure li <*> pure bytes
+
 type SyncBranchFormat = SyncBranchFormat' BranchObjectId TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
 
 localToBranch :: (Ord t, Ord d) => BranchLocalIds' t d p c -> LocalBranch -> (Branch.Full.Branch' t d p c)

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

@@ -3,9 +3,12 @@ module U.Codebase.Sqlite.Causal
     GDbCausal (..),
     SyncCausalFormat,
     SyncCausalFormat' (..),
+    syncCausalFormatCausalHash_,
+    syncCausalFormatValueHash_,
   )
 where
 
+import Control.Lens
 import Data.Vector (Vector)
 import U.Codebase.Sqlite.DbId (BranchHashId, CausalHashId)
 import Unison.Prelude
@@ -24,4 +27,10 @@ data SyncCausalFormat' causalHash valueHash = SyncCausalFormat
   }
   deriving stock (Eq, Show)
 
+syncCausalFormatCausalHash_ :: Traversal (SyncCausalFormat' causalHash valueHash) (SyncCausalFormat' causalHash' valueHash) causalHash causalHash'
+syncCausalFormatCausalHash_ f (SyncCausalFormat v p) = SyncCausalFormat v <$> traverse f p
+
+syncCausalFormatValueHash_ :: Lens (SyncCausalFormat' causalHash valueHash) (SyncCausalFormat' causalHash valueHash') valueHash valueHash'
+syncCausalFormatValueHash_ f (SyncCausalFormat v p) = (\v' -> SyncCausalFormat v' p) <$> f v
+
 type SyncCausalFormat = SyncCausalFormat' CausalHashId BranchHashId

codebase2/codebase-sqlite/U/Codebase/Sqlite/Decl/Format.hs

@@ -2,11 +2,13 @@
 
 module U.Codebase.Sqlite.Decl.Format where
 
+import Control.Lens
 import Data.Vector (Vector)
 import U.Codebase.Decl (DeclR)
 import U.Codebase.Reference (Reference')
 import U.Codebase.Sqlite.DbId (ObjectId, TextId)
 import U.Codebase.Sqlite.LocalIds (LocalDefnId, LocalIds', LocalTextId)
+import U.Codebase.Sqlite.LocalIds qualified as LocalIds
 import U.Codebase.Sqlite.Symbol (Symbol)
 import U.Codebase.Type qualified as Type
 import U.Core.ABT qualified as ABT
@@ -38,10 +40,24 @@ data SyncDeclFormat' t d
   = SyncDecl (SyncLocallyIndexedComponent' t d)
   deriving stock (Eq, Show)
 
+syncDeclFormatTexts_ :: Traversal (SyncDeclFormat' t d) (SyncDeclFormat' t' d) t t'
+syncDeclFormatTexts_ f (SyncDecl c) = SyncDecl <$> syncLocallyIndexedComponentTexts_ f c
+
+syncDeclFormatDefns_ :: Traversal (SyncDeclFormat' t d) (SyncDeclFormat' t d') d d'
+syncDeclFormatDefns_ f (SyncDecl c) = SyncDecl <$> syncLocallyIndexedComponentDefns_ f c
+
 newtype SyncLocallyIndexedComponent' t d
   = SyncLocallyIndexedComponent (Vector (LocalIds' t d, ByteString))
   deriving stock (Eq, Show)
 
+syncLocallyIndexedComponentTexts_ :: Traversal (SyncLocallyIndexedComponent' t d) (SyncLocallyIndexedComponent' t' d) t t'
+syncLocallyIndexedComponentTexts_ f (SyncLocallyIndexedComponent v) =
+  SyncLocallyIndexedComponent <$> (v & traversed . _1 . LocalIds.t_ %%~ f)
+
+syncLocallyIndexedComponentDefns_ :: Traversal (SyncLocallyIndexedComponent' t d) (SyncLocallyIndexedComponent' t d') d d'
+syncLocallyIndexedComponentDefns_ f (SyncLocallyIndexedComponent v) =
+  SyncLocallyIndexedComponent <$> (v & traversed . _1 . LocalIds.h_ %%~ f)
+
 -- [OldDecl] ==map==> [NewDecl] ==number==> [(NewDecl, Int)] ==sort==> [(NewDecl, Int)] ==> permutation is map snd of that
 
 -- type List a = Nil | Cons (List a)

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

@@ -1,5 +1,6 @@
 module U.Codebase.Sqlite.Entity where
 
+import Control.Lens
 import U.Codebase.Sqlite.Branch.Format qualified as Namespace
 import U.Codebase.Sqlite.Causal qualified as Causal
 import U.Codebase.Sqlite.DbId (BranchHashId, BranchObjectId, CausalHashId, HashId, ObjectId, PatchObjectId, TextId)
@@ -33,3 +34,77 @@ entityType = \case
   N _ -> NamespaceType
   P _ -> PatchType
   C _ -> CausalType
+
+texts_ :: Traversal (SyncEntity' text hash defn patch branchh branch causal) (SyncEntity' text' hash defn patch branchh branch causal) text text'
+texts_ f = \case
+  TC tcf -> TC <$> Term.syncTermFormatTexts_ f tcf
+  DC dcf -> DC <$> Decl.syncDeclFormatTexts_ f dcf
+  N ncf -> N <$> Namespace.syncBranchFormatTexts_ f ncf
+  P pcf -> P <$> Patch.syncPatchFormatTexts_ f pcf
+  C ccf -> pure (C ccf)
+
+hashes_ :: Traversal (SyncEntity' text hash defn patch branchh branch causal) (SyncEntity' text hash' defn patch branchh branch causal) hash hash'
+hashes_ f = \case
+  TC tcf -> pure (TC tcf)
+  DC dcf -> pure (DC dcf)
+  N ncf -> pure (N ncf)
+  P pcf -> P <$> Patch.syncPatchFormatHashes_ f pcf
+  C ccf -> pure (C ccf)
+
+defns_ :: Traversal (SyncEntity' text hash defn patch branchh branch causal) (SyncEntity' text hash defn' patch branchh branch causal) defn defn'
+defns_ f = \case
+  TC tcf -> TC <$> Term.syncTermFormatDefns_ f tcf
+  DC dcf -> DC <$> Decl.syncDeclFormatDefns_ f dcf
+  N ncf -> N <$> Namespace.syncBranchFormatDefns_ f ncf
+  P pcf -> P <$> Patch.syncPatchFormatDefns_ f pcf
+  C ccf -> pure (C ccf)
+
+patches_ :: Traversal (SyncEntity' text hash defn patch branchh branch causal) (SyncEntity' text hash defn patch' branchh branch causal) patch patch'
+patches_ f = \case
+  TC tcf -> pure (TC tcf)
+  DC dcf -> pure (DC dcf)
+  N ncf -> N <$> Namespace.syncBranchFormatPatches_ f ncf
+  P pcf -> P <$> Patch.syncPatchFormatParents_ f pcf
+  C ccf -> pure (C ccf)
+
+branchHashes_ :: Traversal (SyncEntity' text hash defn patch branchh branch causal) (SyncEntity' text hash defn patch branchh' branch causal) branchh branchh'
+branchHashes_ f = \case
+  TC tcf -> pure (TC tcf)
+  DC dcf -> pure (DC dcf)
+  N ncf -> pure (N ncf)
+  P pcf -> pure (P pcf)
+  C ccf -> C <$> Causal.syncCausalFormatValueHash_ f ccf
+
+branches_ :: Traversal (SyncEntity' text hash defn patch branchh branch causal) (SyncEntity' text hash defn patch branchh branch' causal) branch branch'
+branches_ f = \case
+  TC tcf -> pure (TC tcf)
+  DC dcf -> pure (DC dcf)
+  N ncf ->
+    ( case ncf of
+        Namespace.SyncFull li bytes -> Namespace.SyncFull <$> (li & Namespace.branchLocalIdsChildren_ . _1 %%~ f) <*> pure bytes
+        Namespace.SyncDiff parent li bytes ->
+          Namespace.SyncDiff
+            <$> (f parent)
+            <*> (li & Namespace.branchLocalIdsChildren_ . _1 %%~ f)
+            <*> pure bytes
+    )
+      <&> N
+  P pcf -> pure (P pcf)
+  C ccf -> pure (C ccf)
+
+causalHashes_ :: Traversal (SyncEntity' text hash defn patch branchh branch causal) (SyncEntity' text hash defn patch branchh branch causal') causal causal'
+causalHashes_ f = \case
+  TC tcf -> pure (TC tcf)
+  DC dcf -> pure (DC dcf)
+  N ncf ->
+    ( case ncf of
+        Namespace.SyncFull li bytes -> Namespace.SyncFull <$> (li & Namespace.branchLocalIdsChildren_ . _2 %%~ f) <*> pure bytes
+        Namespace.SyncDiff parent li bytes ->
+          Namespace.SyncDiff
+            <$> (pure parent)
+            <*> (li & Namespace.branchLocalIdsChildren_ . _2 %%~ f)
+            <*> pure bytes
+    )
+      <&> N
+  P pcf -> pure (P pcf)
+  C ccf -> C <$> Causal.syncCausalFormatCausalHash_ f ccf

codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Format.hs

@@ -2,9 +2,16 @@ module U.Codebase.Sqlite.Patch.Format
   ( PatchFormat (..),
     PatchLocalIds,
     PatchLocalIds' (..),
+    patchLocalIdsTexts_,
+    patchLocalIdsHashes_,
+    patchLocalIdsDefns_,
     HashPatchLocalIds,
     SyncPatchFormat,
     SyncPatchFormat' (..),
+    syncPatchFormatParents_,
+    syncPatchFormatTexts_,
+    syncPatchFormatHashes_,
+    syncPatchFormatDefns_,
     applyPatchDiffs,
     localPatchToPatch,
     localPatchToPatch',
@@ -13,6 +20,7 @@ module U.Codebase.Sqlite.Patch.Format
   )
 where
 
+import Control.Lens
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Vector (Vector)
@@ -42,6 +50,15 @@ data PatchLocalIds' t h d = LocalIds
   }
   deriving stock (Eq, Show)
 
+patchLocalIdsTexts_ :: Traversal (PatchLocalIds' t h d) (PatchLocalIds' t' h d) t t'
+patchLocalIdsTexts_ f (LocalIds t h d) = LocalIds <$> traverse f t <*> pure h <*> pure d
+
+patchLocalIdsHashes_ :: Traversal (PatchLocalIds' t h d) (PatchLocalIds' t h' d) h h'
+patchLocalIdsHashes_ f (LocalIds t h d) = LocalIds <$> pure t <*> traverse f h <*> pure d
+
+patchLocalIdsDefns_ :: Traversal (PatchLocalIds' t h d) (PatchLocalIds' t h d') d d'
+patchLocalIdsDefns_ f (LocalIds t h d) = LocalIds <$> pure t <*> pure h <*> traverse f d
+
 type SyncPatchFormat = SyncPatchFormat' PatchObjectId TextId HashId ObjectId
 
 data SyncPatchFormat' parent text hash defn
@@ -50,6 +67,26 @@ data SyncPatchFormat' parent text hash defn
     SyncDiff parent (PatchLocalIds' text hash defn) ByteString
   deriving stock (Eq, Show)
 
+syncPatchFormatParents_ :: Traversal (SyncPatchFormat' p text hash defn) (SyncPatchFormat' p' text hash defn) p p'
+syncPatchFormatParents_ f = \case
+  (SyncDiff p li b) -> SyncDiff <$> f p <*> pure li <*> pure b
+  (SyncFull li b) -> SyncFull <$> pure li <*> pure b
+
+syncPatchFormatTexts_ :: Traversal (SyncPatchFormat' p text hash defn) (SyncPatchFormat' p text' hash defn) text text'
+syncPatchFormatTexts_ f = \case
+  (SyncDiff p li b) -> SyncDiff p <$> (li & patchLocalIdsTexts_ %%~ f) <*> pure b
+  (SyncFull li b) -> SyncFull <$> (li & patchLocalIdsTexts_ %%~ f) <*> pure b
+
+syncPatchFormatHashes_ :: Traversal (SyncPatchFormat' p text hash defn) (SyncPatchFormat' p text hash' defn) hash hash'
+syncPatchFormatHashes_ f = \case
+  (SyncDiff p li b) -> SyncDiff p <$> (li & patchLocalIdsHashes_ %%~ f) <*> pure b
+  (SyncFull li b) -> SyncFull <$> (li & patchLocalIdsHashes_ %%~ f) <*> pure b
+
+syncPatchFormatDefns_ :: Traversal (SyncPatchFormat' p text hash defn) (SyncPatchFormat' p text hash defn') defn defn'
+syncPatchFormatDefns_ f = \case
+  (SyncDiff p li b) -> SyncDiff p <$> (li & patchLocalIdsDefns_ %%~ f) <*> pure b
+  (SyncFull li b) -> SyncFull <$> (li & patchLocalIdsDefns_ %%~ f) <*> pure b
+
 -- | Apply a list of patch diffs to a patch, left to right.
 applyPatchDiffs :: Patch -> [PatchDiff] -> Patch
 applyPatchDiffs =

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

@@ -218,13 +218,16 @@ module U.Codebase.Sqlite.Queries
     EntityLocation (..),
     entityExists,
     entityLocation,
+    entityLocationSyncV3,
     expectEntity,
     syncToTempEntity,
     insertTempEntity,
+    insertTempEntitySyncV3,
     saveTempEntityInMain,
     expectTempEntity,
     deleteTempEntity,
     clearTempEntityTables,
+    streamTempEntitiesSyncV3,
 
     -- * elaborate hashes
     elaborateHashes,
@@ -254,6 +257,7 @@ module U.Codebase.Sqlite.Queries
     addUpdateBranchTable,
     addDerivedDependentsByDependencyIndex,
     addUpgradeBranchTable,
+    addSyncV3TempTables,
 
     -- ** schema version
     currentSchemaVersion,
@@ -300,6 +304,7 @@ import Data.Aeson qualified as Aeson
 import Data.Aeson.Text qualified as Aeson
 import Data.Bitraversable (bitraverse)
 import Data.ByteString.Lazy (LazyByteString)
+import Data.ByteString.Lazy.Char8 qualified as BL
 import Data.Bytes.Put (runPutS)
 import Data.Foldable qualified as Foldable
 import Data.List qualified as List
@@ -413,7 +418,7 @@ type TextPathSegments = [Text]
 -- * main squeeze
 
 currentSchemaVersion :: SchemaVersion
-currentSchemaVersion = 22
+currentSchemaVersion = 23
 
 runCreateSql :: Transaction ()
 runCreateSql =
@@ -499,6 +504,10 @@ addUpgradeBranchTable :: Transaction ()
 addUpgradeBranchTable =
   executeStatements $(embedProjectStringFile "sql/019-add-upgrade-branch-table.sql")
 
+addSyncV3TempTables :: Transaction ()
+addSyncV3TempTables =
+  executeStatements $(embedProjectStringFile "sql/020-add-sync-v3-temp-tables.sql")
+
 schemaVersion :: Transaction SchemaVersion
 schemaVersion =
   queryOneCol
@@ -2232,6 +2241,16 @@ entityLocation hash =
         True -> Just EntityInTempStorage
         False -> Nothing
 
+entityLocationSyncV3 :: Hash32 -> Transaction (Maybe EntityLocation)
+entityLocationSyncV3 hash =
+  entityExists hash >>= \case
+    True -> pure (Just EntityInMainStorage)
+    False -> do
+      let theSql = [sql| SELECT EXISTS (SELECT 1 FROM syncv3_temp_entity WHERE entity_hash = :hash) |]
+      queryOneCol theSql <&> \case
+        True -> Just EntityInTempStorage
+        False -> Nothing
+
 -- | Does this entity already exist in the database, i.e. in the `object` or `causal` table?
 entityExists :: Hash32 -> Transaction Bool
 entityExists hash = do
@@ -2285,6 +2304,15 @@ insertTempEntity entityHash entity missingDependencies = do
     entityType =
       Entity.entityType entity
 
+insertTempEntitySyncV3 :: Hash32 -> Text -> Hash32 -> Int64 -> BL.ByteString -> Transaction ()
+insertTempEntitySyncV3 rootCausal entityKind entityHash entityDepth entityBlob = do
+  execute
+    [sql|
+      INSERT INTO syncv3_temp_entity (root_causal, entity_hash, entity_kind, entity_data, entity_depth)
+      VALUES (:rootCausal, :entityHash, :entityKind, :entityBlob, :entityDepth)
+      ON CONFLICT DO NOTHING
+    |]
+
 -- | Delete a row from the `temp_entity` table, if it exists.
 deleteTempEntity :: Hash32 -> Transaction ()
 deleteTempEntity hash =
@@ -4005,3 +4033,14 @@ saveSquashResult bhId chId =
         )
       ON CONFLICT DO NOTHING
     |]
+
+streamTempEntitiesSyncV3 :: Hash32 -> (Transaction (Maybe (Hash32, BL.ByteString)) -> Transaction a) -> Transaction a
+streamTempEntitiesSyncV3 rootCausalHash action = do
+  Sqlite.queryStreamRow @(Hash32, BL.ByteString)
+    [sql|
+    SELECT entity_hash, entity_data
+      FROM syncv3_temp_entity
+      WHERE root_causal = :rootCausalHash
+      ORDER BY entity_depth ASC
+    |]
+    action