More useful traversals

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

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

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

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 =