diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/TempEntity.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/TempEntity.hs index f1336d234..aff0e5df8 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/TempEntity.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/TempEntity.hs @@ -3,9 +3,10 @@ module U.Codebase.Sqlite.TempEntity where import qualified U.Codebase.Sqlite.Branch.Format as Namespace import qualified U.Codebase.Sqlite.Causal as Causal import qualified U.Codebase.Sqlite.Decl.Format as Decl +import qualified U.Codebase.Sqlite.Entity as Entity +import U.Codebase.Sqlite.LocalIds (LocalIds') import qualified U.Codebase.Sqlite.Patch.Format as Patch import qualified U.Codebase.Sqlite.Term.Format as Term -import qualified U.Codebase.Sqlite.Entity as Entity import U.Util.Base32Hex (Base32Hex) import Unison.Prelude @@ -19,6 +20,8 @@ import Unison.Prelude type TempEntity = Entity.SyncEntity' Text Base32Hex Base32Hex Base32Hex Base32Hex Base32Hex Base32Hex +type TempLocalIds = LocalIds' Text Base32Hex + type TempTermFormat = Term.SyncTermFormat' Text Base32Hex type TempDeclFormat = Decl.SyncDeclFormat' Text Base32Hex diff --git a/unison-cli/src/Unison/Share/Sync.hs b/unison-cli/src/Unison/Share/Sync.hs index 5bf1ad465..bce929dbd 100644 --- a/unison-cli/src/Unison/Share/Sync.hs +++ b/unison-cli/src/Unison/Share/Sync.hs @@ -32,6 +32,7 @@ import U.Codebase.Sqlite.LocalIds (LocalIds' (..)) import qualified U.Codebase.Sqlite.Patch.Format as PatchFormat import qualified U.Codebase.Sqlite.Queries as Q import U.Codebase.Sqlite.TempEntity (TempEntity) +import qualified U.Codebase.Sqlite.TempEntity as TempEntity import qualified U.Codebase.Sqlite.Term.Format as TermFormat import U.Util.Base32Hex (Base32Hex) import qualified U.Util.Hash as Hash @@ -388,15 +389,9 @@ entityToTempEntity = \case & DeclFormat.SyncDecl & Entity.DC Share.P Share.Patch {textLookup, oldHashLookup, newHashLookup, bytes} -> - Entity.P - ( PatchFormat.SyncFull - PatchFormat.LocalIds - { patchTextLookup = Vector.fromList textLookup, - patchHashLookup = Vector.fromList (coerce @[Share.Hash] @[Base32Hex] oldHashLookup), - patchDefnLookup = Vector.fromList (map jwt32 newHashLookup) - } - bytes - ) + Entity.P (PatchFormat.SyncFull (mungePatchLocalIds textLookup oldHashLookup newHashLookup) bytes) + Share.PD Share.PatchDiff {parent, textLookup, oldHashLookup, newHashLookup, bytes} -> + Entity.P (PatchFormat.SyncDiff (jwt32 parent) (mungePatchLocalIds textLookup oldHashLookup newHashLookup) bytes) Share.N Share.Namespace {textLookup, defnLookup, patchLookup, childLookup, bytes} -> Entity.N ( NamespaceFormat.SyncFull @@ -415,13 +410,21 @@ entityToTempEntity = \case parents = Vector.fromList (map jwt32 (Set.toList parents)) } where - mungeLocalIds :: Share.LocalIds Text Share.HashJWT -> LocalIds' Text Base32Hex + mungeLocalIds :: Share.LocalIds Text Share.HashJWT -> TempEntity.TempLocalIds mungeLocalIds Share.LocalIds {texts, hashes} = LocalIds { textLookup = Vector.fromList texts, defnLookup = Vector.map jwt32 (Vector.fromList hashes) } + mungePatchLocalIds :: [Text] -> [Share.Hash] -> [Share.HashJWT] -> TempEntity.TempPatchLocalIds + mungePatchLocalIds textLookup oldHashLookup newHashLookup = + PatchFormat.LocalIds + { patchTextLookup = Vector.fromList textLookup, + patchHashLookup = Vector.fromList (coerce @[Share.Hash] @[Base32Hex] oldHashLookup), + patchDefnLookup = Vector.fromList (map jwt32 newHashLookup) + } + jwt32 :: Share.HashJWT -> Base32Hex jwt32 = Share.toBase32Hex . Share.hashJWTHash diff --git a/unison-share-api/src/Unison/Sync/Types.hs b/unison-share-api/src/Unison/Sync/Types.hs index f2d7194ca..c471cdaf9 100644 --- a/unison-share-api/src/Unison/Sync/Types.hs +++ b/unison-share-api/src/Unison/Sync/Types.hs @@ -319,6 +319,7 @@ data Entity text noSyncHash hash = TC (TermComponent text hash) | DC (DeclComponent text hash) | P (Patch text noSyncHash hash) + | PD (PatchDiff text noSyncHash hash) | N (Namespace text hash) | C (Causal hash) deriving stock (Show, Eq, Ord) @@ -340,6 +341,11 @@ instance (ToJSON text, ToJSON noSyncHash, ToJSON hash) => ToJSON (Entity text no [ "type" .= PatchType, "object" .= patch ] + PD patch -> + object + [ "type" .= PatchDiffType, + "object" .= patch + ] N ns -> object [ "type" .= NamespaceType, @@ -358,6 +364,7 @@ instance (FromJSON text, FromJSON noSyncHash, FromJSON hash, Ord hash) => FromJS TermComponentType -> TC <$> obj .: "object" DeclComponentType -> DC <$> obj .: "object" PatchType -> P <$> obj .: "object" + PatchDiffType -> PD <$> obj .: "object" NamespaceType -> N <$> obj .: "object" CausalType -> C <$> obj .: "object" @@ -369,6 +376,7 @@ entityDependencies = \case TC (TermComponent terms) -> flip foldMap terms \(LocalIds {hashes}, _term) -> Set.fromList hashes DC (DeclComponent decls) -> flip foldMap decls \(LocalIds {hashes}, _decl) -> Set.fromList hashes P Patch {newHashLookup} -> Set.fromList newHashLookup + PD PatchDiff {parent, newHashLookup} -> Set.insert parent (Set.fromList newHashLookup) N Namespace {defnLookup, patchLookup, childLookup} -> Set.fromList defnLookup <> Set.fromList patchLookup <> foldMap (\(namespaceHash, causalHash) -> Set.fromList [namespaceHash, causalHash]) childLookup @@ -505,6 +513,34 @@ instance (FromJSON text, FromJSON oldHash, FromJSON newHash) => FromJSON (Patch Base64Bytes bytes <- obj .: "bytes" pure Patch {..} +data PatchDiff text oldHash hash = PatchDiff + { parent :: hash, + textLookup :: [text], + oldHashLookup :: [oldHash], + newHashLookup :: [hash], + bytes :: ByteString + } + deriving stock (Eq, Ord, Show) + +instance (ToJSON text, ToJSON oldHash, ToJSON hash) => ToJSON (PatchDiff text oldHash hash) where + toJSON (PatchDiff parent textLookup oldHashLookup newHashLookup bytes) = + object + [ "parent" .= parent, + "text_lookup" .= textLookup, + "optional_hash_lookup" .= oldHashLookup, + "hash_lookup" .= newHashLookup, + "bytes" .= Base64Bytes bytes + ] + +instance (FromJSON text, FromJSON oldHash, FromJSON hash) => FromJSON (PatchDiff text oldHash hash) where + parseJSON = Aeson.withObject "PatchDiff" \obj -> do + parent <- obj .: "parent" + textLookup <- obj .: "text_lookup" + oldHashLookup <- obj .: "optional_hash_lookup" + newHashLookup <- obj .: "hash_lookup" + Base64Bytes bytes <- obj .: "bytes" + pure PatchDiff {..} + data Namespace text hash = Namespace { textLookup :: [text], defnLookup :: [hash], @@ -573,6 +609,7 @@ data EntityType = TermComponentType | DeclComponentType | PatchType + | PatchDiffType | NamespaceType | CausalType deriving stock (Eq, Ord, Show) @@ -582,6 +619,7 @@ instance ToJSON EntityType where TermComponentType -> "term_component" DeclComponentType -> "decl_component" PatchType -> "patch" + PatchDiffType -> "patch_diff" NamespaceType -> "namespace" CausalType -> "causal" @@ -590,6 +628,7 @@ instance FromJSON EntityType where "term_component" -> pure TermComponentType "decl_component" -> pure DeclComponentType "patch" -> pure PatchType + "patch_diff" -> pure PatchDiffType "namespace" -> pure NamespaceType "causal" -> pure CausalType t -> failText $ "Unexpected entity type: " <> t