diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Format.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Format.hs index c64ac0f53..ce07a487f 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Format.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Format.hs @@ -11,6 +11,7 @@ module U.Codebase.Sqlite.Branch.Format localToDbBranch, localToDbDiff, localToHashBranch, + localToBranch, -- dbToLocalDiff, ) where diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Format.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Format.hs index 263fec4bb..46dea7220 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Format.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Format.hs @@ -6,6 +6,7 @@ module U.Codebase.Sqlite.Patch.Format SyncPatchFormat' (..), applyPatchDiffs, localPatchToPatch, + localPatchToPatch', localPatchDiffToPatchDiff, ) where @@ -68,6 +69,15 @@ localPatchToPatch :: PatchLocalIds -> LocalPatch -> Patch localPatchToPatch li = Patch.Full.trimap (lookupPatchLocalText li) (lookupPatchLocalHash li) (lookupPatchLocalDefn li) +-- | Generic version of `localPatchToPatch` that works with any `PatchLocalIds'`. +localPatchToPatch' :: + (Ord t, Ord h, Ord d) => + PatchLocalIds' t h d -> + Patch' LocalTextId LocalHashId LocalDefnId -> + Patch' t h d +localPatchToPatch' li = + Patch.Full.trimap (lookupPatchLocalText li) (lookupPatchLocalHash li) (lookupPatchLocalDefn li) + localPatchDiffToPatchDiff :: PatchLocalIds -> LocalPatchDiff -> PatchDiff localPatchDiffToPatchDiff li = Patch.Diff.trimap @@ -75,11 +85,11 @@ localPatchDiffToPatchDiff li = (lookupPatchLocalHash li) (lookupPatchLocalDefn li) -lookupPatchLocalText :: PatchLocalIds -> LocalTextId -> TextId +lookupPatchLocalText :: PatchLocalIds' t h d -> LocalTextId -> t lookupPatchLocalText li (LocalTextId w) = patchTextLookup li Vector.! fromIntegral w -lookupPatchLocalHash :: PatchLocalIds -> LocalHashId -> HashId +lookupPatchLocalHash :: PatchLocalIds' t h d -> LocalHashId -> h lookupPatchLocalHash li (LocalHashId w) = patchHashLookup li Vector.! fromIntegral w -lookupPatchLocalDefn :: PatchLocalIds -> LocalDefnId -> ObjectId +lookupPatchLocalDefn :: PatchLocalIds' t h d -> LocalDefnId -> d lookupPatchLocalDefn li (LocalDefnId w) = patchDefnLookup li Vector.! fromIntegral w diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs index 7f3252848..677aab063 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Full.hs @@ -1,6 +1,7 @@ module U.Codebase.Sqlite.Patch.Full where import Control.Lens +import Data.Bitraversable (Bitraversable, bitraverse) import Data.Map (Map) import Data.Set (Set) import Data.Set qualified as Set @@ -42,6 +43,16 @@ data Patch' t h o = Patch typeEdits :: Map (Reference' t h) (Set (TypeEdit' t o)) } +patchT_ :: (Ord t', Ord h, Ord o) => Traversal (Patch' t h o) (Patch' t' h o) t t' +patchT_ f Patch {termEdits, typeEdits} = do + newTermEdits <- + traverseOf (Map.bitraversed (Referent.refs_ . Reference.t_) (Set.traverse . traverseFirst)) f termEdits + newTypeEdits <- traverseOf (Map.bitraversed (Reference.t_) (Set.traverse . traverseFirst)) f typeEdits + pure Patch {termEdits = newTermEdits, typeEdits = newTypeEdits} + where + traverseFirst :: Bitraversable b => Traversal (b a c) (b a' c) a a' + traverseFirst f = bitraverse f pure + patchH_ :: (Ord t, Ord h') => Traversal (Patch' t h o) (Patch' t h' o) h h' patchH_ f Patch {termEdits, typeEdits} = do newTermEdits <- termEdits & Map.traverseKeys . Referent.refs_ . Reference.h_ %%~ f diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs index 9899dacb5..e9cf9768e 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Serialization.hs @@ -11,6 +11,7 @@ module U.Codebase.Sqlite.Serialization getDeclElement, getDeclFormat, getPatchFormat, + getLocalPatch, getTempCausalFormat, getTempDeclFormat, getTempNamespaceFormat, @@ -550,15 +551,10 @@ putPatchFormat = \case getPatchFormat :: (MonadGet m) => m PatchFormat.PatchFormat getPatchFormat = getWord8 >>= \case - 0 -> PatchFormat.Full <$> getPatchLocalIds <*> getPatchFull + 0 -> PatchFormat.Full <$> getPatchLocalIds <*> getLocalPatch 1 -> PatchFormat.Diff <$> getVarInt <*> getPatchLocalIds <*> getPatchDiff x -> unknownTag "getPatchFormat" x where - getPatchFull :: (MonadGet m) => m PatchFull.LocalPatch - getPatchFull = - PatchFull.Patch - <$> getMap getReferent (getSet getTermEdit) - <*> getMap getReference (getSet getTypeEdit) getPatchDiff :: (MonadGet m) => m PatchDiff.LocalPatchDiff getPatchDiff = PatchDiff.PatchDiff @@ -566,25 +562,34 @@ getPatchFormat = <*> getMap getReference (getSet getTypeEdit) <*> getMap getReferent (getSet getTermEdit) <*> getMap getReference (getSet getTypeEdit) - getTermEdit :: (MonadGet m) => m TermEdit.LocalTermEdit - getTermEdit = - getWord8 >>= \case - 0 -> pure TermEdit.Deprecate - 1 -> TermEdit.Replace <$> getReferent <*> getTyping - x -> unknownTag "getTermEdit" x - getTyping :: (MonadGet m) => m TermEdit.Typing - getTyping = - getWord8 >>= \case - 0 -> pure TermEdit.Same - 1 -> pure TermEdit.Subtype - 2 -> pure TermEdit.Different - x -> unknownTag "getTyping" x - getTypeEdit :: (MonadGet m) => m TypeEdit.LocalTypeEdit - getTypeEdit = - getWord8 >>= \case - 0 -> pure TypeEdit.Deprecate - 1 -> TypeEdit.Replace <$> getReference - x -> unknownTag "getTypeEdit" x + +getLocalPatch :: (MonadGet m) => m PatchFull.LocalPatch +getLocalPatch = + PatchFull.Patch + <$> getMap getReferent (getSet getTermEdit) + <*> getMap getReference (getSet getTypeEdit) + +getTermEdit :: (MonadGet m) => m TermEdit.LocalTermEdit +getTermEdit = + getWord8 >>= \case + 0 -> pure TermEdit.Deprecate + 1 -> TermEdit.Replace <$> getReferent <*> getTyping + x -> unknownTag "getTermEdit" x + +getTyping :: (MonadGet m) => m TermEdit.Typing +getTyping = + getWord8 >>= \case + 0 -> pure TermEdit.Same + 1 -> pure TermEdit.Subtype + 2 -> pure TermEdit.Different + x -> unknownTag "getTyping" x + +getTypeEdit :: (MonadGet m) => m TypeEdit.LocalTypeEdit +getTypeEdit = + getWord8 >>= \case + 0 -> pure TypeEdit.Deprecate + 1 -> TypeEdit.Replace <$> getReference + x -> unknownTag "getTypeEdit" x getPatchLocalIds :: (MonadGet m) => m PatchFormat.PatchLocalIds getPatchLocalIds =