rewrite Queries/Operations to use Transaction

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

@@ -157,7 +157,6 @@ import qualified U.Core.ABT as ABT
 import qualified U.Util.Base32Hex as Base32Hex
 import qualified U.Util.Hash as H
 import qualified U.Util.Lens as Lens
-import qualified U.Util.Monoid as Monoid
 import U.Util.Serialization (Get)
 import qualified U.Util.Serialization as S
 import qualified U.Util.Term as TermUtil
@@ -190,25 +189,25 @@ getFromBytesOr decoder get bs = case runGetS get bs of
 
 -- * Database lookups
 
-objectExistsForHash :: DB m => H.Hash -> m Bool
+objectExistsForHash :: H.Hash -> Transaction Bool
 objectExistsForHash h =
   isJust <$> runMaybeT do
     id <- MaybeT . Q.loadHashId . H.toBase32Hex $ h
     MaybeT $ Q.loadObjectIdForAnyHashId id
 
-expectValueHashByCausalHashId :: DB m => Db.CausalHashId -> m BranchHash
+expectValueHashByCausalHashId :: Db.CausalHashId -> Transaction BranchHash
 expectValueHashByCausalHashId = loadValueHashById <=< Q.expectCausalValueHashId
   where
-    loadValueHashById :: DB m => Db.BranchHashId -> m BranchHash
+    loadValueHashById :: Db.BranchHashId -> Transaction BranchHash
     loadValueHashById = fmap BranchHash . Q.expectHash . Db.unBranchHashId
 
-expectRootCausalHash :: DB m => m CausalHash
+expectRootCausalHash :: Transaction CausalHash
 expectRootCausalHash = Q.expectCausalHash =<< Q.expectNamespaceRoot
 
-loadRootCausalHash :: DB m => m (Maybe CausalHash)
+loadRootCausalHash :: Transaction (Maybe CausalHash)
 loadRootCausalHash =
   runMaybeT $
-    Q.expectCausalHash =<< MaybeT Q.loadNamespaceRoot
+    lift . Q.expectCausalHash =<< MaybeT Q.loadNamespaceRoot
 
 -- * Reference transformations
 
@@ -217,54 +216,54 @@ loadRootCausalHash =
 -- | Assumes that a derived reference would already exist in the database
 --  (by virtue of dependencies being stored before dependents), but does
 --  not assume a builtin reference would.
-c2sReference :: DB m => C.Reference -> m S.Reference
+c2sReference :: C.Reference -> Transaction S.Reference
 c2sReference = bitraverse Q.saveText Q.expectObjectIdForPrimaryHash
 
-s2cReference :: DB m => S.Reference -> m C.Reference
+s2cReference :: S.Reference -> Transaction C.Reference
 s2cReference = bitraverse Q.expectText Q.expectPrimaryHashByObjectId
 
-c2sReferenceId :: DB m => C.Reference.Id -> m S.Reference.Id
+c2sReferenceId :: C.Reference.Id -> Transaction S.Reference.Id
 c2sReferenceId = C.Reference.idH Q.expectObjectIdForPrimaryHash
 
-s2cReferenceId :: DB m => S.Reference.Id -> m C.Reference.Id
+s2cReferenceId :: S.Reference.Id -> Transaction C.Reference.Id
 s2cReferenceId = C.Reference.idH Q.expectPrimaryHashByObjectId
 
-h2cReferenceId :: DB m => S.Reference.IdH -> m C.Reference.Id
+h2cReferenceId :: S.Reference.IdH -> Transaction C.Reference.Id
 h2cReferenceId = C.Reference.idH Q.expectHash
 
-h2cReference :: DB m => S.ReferenceH -> m C.Reference
+h2cReference :: S.ReferenceH -> Transaction C.Reference
 h2cReference = bitraverse Q.expectText Q.expectHash
 
-c2hReference :: DB m => C.Reference -> MaybeT m S.ReferenceH
+c2hReference :: C.Reference -> MaybeT Transaction S.ReferenceH
 c2hReference = bitraverse (MaybeT . Q.loadTextId) (MaybeT . Q.loadHashIdByHash)
 
-s2cReferent :: DB m => S.Referent -> m C.Referent
+s2cReferent :: S.Referent -> Transaction C.Referent
 s2cReferent = bitraverse s2cReference s2cReference
 
-s2cReferentId :: DB m => S.Referent.Id -> m C.Referent.Id
+s2cReferentId :: S.Referent.Id -> Transaction C.Referent.Id
 s2cReferentId = bitraverse Q.expectPrimaryHashByObjectId Q.expectPrimaryHashByObjectId
 
-c2sReferent :: DB m => C.Referent -> m S.Referent
+c2sReferent :: C.Referent -> Transaction S.Referent
 c2sReferent = bitraverse c2sReference c2sReference
 
-c2sReferentId :: DB m => C.Referent.Id -> m S.Referent.Id
+c2sReferentId :: C.Referent.Id -> Transaction S.Referent.Id
 c2sReferentId = bitraverse Q.expectObjectIdForPrimaryHash Q.expectObjectIdForPrimaryHash
 
-h2cReferent :: DB m => S.ReferentH -> m C.Referent
+h2cReferent :: S.ReferentH -> Transaction C.Referent
 h2cReferent = bitraverse h2cReference h2cReference
 
 -- ** convert and save references
 
 -- | Save the text and hash parts of a Reference to the database and substitute their ids.
-saveReferenceH :: DB m => C.Reference -> m S.ReferenceH
+saveReferenceH :: C.Reference -> Transaction S.ReferenceH
 saveReferenceH = bitraverse Q.saveText Q.saveHashHash
 
-saveReferentH :: DB m => C.Referent -> m S.ReferentH
+saveReferentH :: C.Referent -> Transaction S.ReferentH
 saveReferentH = bitraverse saveReferenceH saveReferenceH
 
 -- ** Edits transformations
 
-s2cTermEdit :: DB m => S.TermEdit -> m C.TermEdit
+s2cTermEdit :: S.TermEdit -> Transaction C.TermEdit
 s2cTermEdit = \case
   S.TermEdit.Replace r t -> C.TermEdit.Replace <$> s2cReferent r <*> pure (s2cTyping t)
   S.TermEdit.Deprecate -> pure C.TermEdit.Deprecate
@@ -281,13 +280,13 @@ c2sTyping = \case
   C.TermEdit.Subtype -> S.TermEdit.Subtype
   C.TermEdit.Different -> S.TermEdit.Different
 
-s2cTypeEdit :: DB m => S.TypeEdit -> m C.TypeEdit
+s2cTypeEdit :: S.TypeEdit -> Transaction C.TypeEdit
 s2cTypeEdit = \case
   S.TypeEdit.Replace r -> C.TypeEdit.Replace <$> s2cReference r
   S.TypeEdit.Deprecate -> pure C.TypeEdit.Deprecate
 
 -- | assumes that all relevant defns are already in the DB
-c2sPatch :: DB m => C.Branch.Patch -> m S.Patch
+c2sPatch :: C.Branch.Patch -> Transaction S.Patch
 c2sPatch (C.Branch.Patch termEdits typeEdits) =
   S.Patch
     <$> Map.bitraverse saveReferentH (Set.traverse c2sTermEdit) termEdits
@@ -351,7 +350,7 @@ decodeDeclFormat = getFromBytesOr "getDeclFormat" S.getDeclFormat
 decodeDeclElement :: Word64 -> ByteString -> Either DecodeError (LocalIds, S.Decl.Decl Symbol)
 decodeDeclElement i = getFromBytesOr ("lookupDeclElement " <> tShow i) (S.lookupDeclElement i)
 
-getCycleLen :: DB m => H.Hash -> m (Maybe Word64)
+getCycleLen :: H.Hash -> Transaction (Maybe Word64)
 getCycleLen h = do
   when debug $ traceM $ "\ngetCycleLen " ++ (Text.unpack . Base32Hex.toText $ H.toBase32Hex h)
   runMaybeT do
@@ -362,14 +361,14 @@ getCycleLen h = do
     -- components) have the same basic serialized structure: first a format
     -- byte that is always 0 for now, followed by a framed array representing
     -- the strongly-connected component. :grimace:
-    Q.expectObject oid decodeComponentLengthOnly
+    lift (Q.expectObject oid decodeComponentLengthOnly)
 
 -- | Get the 'C.DeclType.DeclType' of a 'C.Reference.Id'.
-expectDeclTypeById :: DB m => C.Reference.Id -> m C.Decl.DeclType
+expectDeclTypeById :: C.Reference.Id -> Transaction C.Decl.DeclType
 expectDeclTypeById =
   fmap C.Decl.declType . expectDeclByReference
 
-componentByObjectId :: DB m => Db.ObjectId -> m [S.Reference.Id]
+componentByObjectId :: Db.ObjectId -> Transaction [S.Reference.Id]
 componentByObjectId id = do
   when debug . traceM $ "Operations.componentByObjectId " ++ show id
   len <- Q.expectObject id decodeComponentLengthOnly
@@ -379,13 +378,13 @@ componentByObjectId id = do
 
 -- ** Saving & loading terms
 
-loadTermComponent :: DB m => H.Hash -> MaybeT m [(C.Term Symbol, C.Term.Type Symbol)]
+loadTermComponent :: H.Hash -> MaybeT Transaction [(C.Term Symbol, C.Term.Type Symbol)]
 loadTermComponent h = do
   oid <- MaybeT (Q.loadObjectIdForAnyHash h)
   S.Term.Term (S.Term.LocallyIndexedComponent elements) <- MaybeT (Q.loadTermObject oid decodeTermFormat)
   lift . traverse (uncurry3 s2cTermWithType) $ Foldable.toList elements
 
-saveTermComponent :: DB m => H.Hash -> [(C.Term Symbol, C.Term.Type Symbol)] -> m Db.ObjectId
+saveTermComponent :: H.Hash -> [(C.Term Symbol, C.Term.Type Symbol)] -> Transaction Db.ObjectId
 saveTermComponent h terms = do
   when debug . traceM $ "Operations.saveTermComponent " ++ show h
   sTermElements <- traverse (uncurry c2sTerm) terms
@@ -534,40 +533,40 @@ c2xTerm saveText saveDefn tm tp =
               (Vector.fromList (Foldable.toList defnIds))
       pure (ids, void tm, void <$> tp)
 
-loadTermWithTypeByReference :: DB m => C.Reference.Id -> MaybeT m (C.Term Symbol, C.Term.Type Symbol)
+loadTermWithTypeByReference :: C.Reference.Id -> MaybeT Transaction (C.Term Symbol, C.Term.Type Symbol)
 loadTermWithTypeByReference (C.Reference.Id h i) = do
   oid <- MaybeT (Q.loadObjectIdForPrimaryHash h)
   -- retrieve and deserialize the blob
   (localIds, term, typ) <- MaybeT (Q.loadTermObject oid (decodeTermElementWithType i))
-  s2cTermWithType localIds term typ
+  lift (s2cTermWithType localIds term typ)
 
-loadTermByReference :: DB m => C.Reference.Id -> MaybeT m (C.Term Symbol)
+loadTermByReference :: C.Reference.Id -> MaybeT Transaction (C.Term Symbol)
 loadTermByReference r@(C.Reference.Id h i) = do
   when debug . traceM $ "loadTermByReference " ++ show r
   oid <- MaybeT (Q.loadObjectIdForPrimaryHash h)
   -- retrieve and deserialize the blob
   (localIds, term) <- MaybeT (Q.loadTermObject oid (decodeTermElementDiscardingType i))
-  s2cTerm localIds term
+  lift (s2cTerm localIds term)
 
-loadTypeOfTermByTermReference :: DB m => C.Reference.Id -> MaybeT m (C.Term.Type Symbol)
+loadTypeOfTermByTermReference :: C.Reference.Id -> MaybeT Transaction (C.Term.Type Symbol)
 loadTypeOfTermByTermReference id@(C.Reference.Id h i) = do
   when debug . traceM $ "loadTypeOfTermByTermReference " ++ show id
   oid <- MaybeT (Q.loadObjectIdForPrimaryHash h)
   -- retrieve and deserialize the blob
   (localIds, typ) <- MaybeT (Q.loadTermObject oid (decodeTermElementDiscardingTerm i))
-  s2cTypeOfTerm localIds typ
+  lift (s2cTypeOfTerm localIds typ)
 
-s2cTermWithType :: DB m => LocalIds -> S.Term.Term -> S.Term.Type -> m (C.Term Symbol, C.Term.Type Symbol)
+s2cTermWithType :: LocalIds -> S.Term.Term -> S.Term.Type -> Transaction (C.Term Symbol, C.Term.Type Symbol)
 s2cTermWithType ids tm tp = do
   (substText, substHash) <- localIdsToLookups Q.expectText Q.expectPrimaryHashByObjectId ids
   pure (x2cTerm substText substHash tm, x2cTType substText substHash tp)
 
-s2cTerm :: DB m => LocalIds -> S.Term.Term -> m (C.Term Symbol)
+s2cTerm :: LocalIds -> S.Term.Term -> Transaction (C.Term Symbol)
 s2cTerm ids tm = do
   (substText, substHash) <- localIdsToLookups Q.expectText Q.expectPrimaryHashByObjectId ids
   pure $ x2cTerm substText substHash tm
 
-s2cTypeOfTerm :: DB m => LocalIds -> S.Term.Type -> m (C.Term.Type Symbol)
+s2cTypeOfTerm :: LocalIds -> S.Term.Type -> Transaction (C.Term.Type Symbol)
 s2cTypeOfTerm ids tp = do
   (substText, substHash) <- localIdsToLookups Q.expectText Q.expectPrimaryHashByObjectId ids
   pure $ x2cTType substText substHash tp
@@ -581,7 +580,7 @@ localIdsToLookups loadText loadHash localIds = do
       substHash (LocalDefnId w) = hashes Vector.! fromIntegral w
   pure (substText, substHash)
 
-localIdsToTypeRefLookup :: DB m => LocalIds -> m (S.Decl.TypeRef -> C.Decl.TypeRef)
+localIdsToTypeRefLookup :: LocalIds -> Transaction (S.Decl.TypeRef -> C.Decl.TypeRef)
 localIdsToTypeRefLookup localIds = do
   (substText, substHash) <- localIdsToLookups Q.expectText Q.expectPrimaryHashByObjectId localIds
   pure $ bimap substText (fmap substHash)
@@ -644,48 +643,48 @@ lookup_ stateLens writerLens mk t = do
       pure id
     Just t' -> pure t'
 
-c2sTerm :: DB m => C.Term Symbol -> C.Term.Type Symbol -> m (LocalIds, S.Term.Term, S.Term.Type)
+c2sTerm :: C.Term Symbol -> C.Term.Type Symbol -> Transaction (LocalIds, S.Term.Term, S.Term.Type)
 c2sTerm tm tp = c2xTerm Q.saveText Q.expectObjectIdForPrimaryHash tm (Just tp) <&> \(w, tm, Just tp) -> (w, tm, tp)
 
 -- *** Watch expressions
 
-listWatches :: DB m => WatchKind -> m [C.Reference.Id]
+listWatches :: WatchKind -> Transaction [C.Reference.Id]
 listWatches k = Q.loadWatchesByWatchKind k >>= traverse h2cReferenceId
 
 -- | returns Nothing if the expression isn't cached.
-loadWatch :: DB m => WatchKind -> C.Reference.Id -> MaybeT m (C.Term Symbol)
+loadWatch :: WatchKind -> C.Reference.Id -> MaybeT Transaction (C.Term Symbol)
 loadWatch k r = do
-  r' <- C.Reference.idH Q.saveHashHash r
+  r' <- C.Reference.idH (lift . Q.saveHashHash) r
   S.Term.WatchResult wlids t <- MaybeT (Q.loadWatch k r' (getFromBytesOr "getWatchResultFormat" S.getWatchResultFormat))
-  w2cTerm wlids t
+  lift (w2cTerm wlids t)
 
-saveWatch :: DB m => WatchKind -> C.Reference.Id -> C.Term Symbol -> m ()
+saveWatch :: WatchKind -> C.Reference.Id -> C.Term Symbol -> Transaction ()
 saveWatch w r t = do
   rs <- C.Reference.idH Q.saveHashHash r
   wterm <- c2wTerm t
   let bytes = S.putBytes S.putWatchResultFormat (uncurry S.Term.WatchResult wterm)
   Q.saveWatch w rs bytes
 
-clearWatches :: DB m => m ()
+clearWatches :: Transaction ()
 clearWatches = Q.clearWatches
 
-c2wTerm :: DB m => C.Term Symbol -> m (WatchLocalIds, S.Term.Term)
+c2wTerm :: C.Term Symbol -> Transaction (WatchLocalIds, S.Term.Term)
 c2wTerm tm = c2xTerm Q.saveText Q.saveHashHash tm Nothing <&> \(w, tm, _) -> (w, tm)
 
-w2cTerm :: DB m => WatchLocalIds -> S.Term.Term -> m (C.Term Symbol)
+w2cTerm :: WatchLocalIds -> S.Term.Term -> Transaction (C.Term Symbol)
 w2cTerm ids tm = do
   (substText, substHash) <- localIdsToLookups Q.expectText Q.expectHash ids
   pure $ x2cTerm substText substHash tm
 
 -- ** Saving & loading type decls
 
-loadDeclComponent :: DB m => H.Hash -> MaybeT m [C.Decl Symbol]
+loadDeclComponent :: H.Hash -> MaybeT Transaction [C.Decl Symbol]
 loadDeclComponent h = do
   oid <- MaybeT (Q.loadObjectIdForAnyHash h)
   S.Decl.Decl (S.Decl.LocallyIndexedComponent elements) <- MaybeT (Q.loadDeclObject oid decodeDeclFormat)
   lift . traverse (uncurry s2cDecl) $ Foldable.toList elements
 
-saveDeclComponent :: DB m => H.Hash -> [C.Decl Symbol] -> m Db.ObjectId
+saveDeclComponent :: H.Hash -> [C.Decl Symbol] -> Transaction Db.ObjectId
 saveDeclComponent h decls = do
   when debug . traceM $ "Operations.saveDeclComponent " ++ show h
   sDeclElements <- traverse (c2sDecl Q.saveText Q.expectObjectIdForPrimaryHash) decls
@@ -709,7 +708,13 @@ saveDeclComponent h decls = do
 
   pure oId
 
-c2sDecl :: forall m t d. DB m => (Text -> m t) -> (H.Hash -> m d) -> C.Decl Symbol -> m (LocalIds' t d, S.Decl.Decl Symbol)
+c2sDecl ::
+  forall m t d.
+  Monad m =>
+  (Text -> m t) ->
+  (H.Hash -> m d) ->
+  C.Decl Symbol ->
+  m (LocalIds' t d, S.Decl.Decl Symbol)
 c2sDecl saveText saveDefn (C.Decl.DataDeclaration dt m b cts) = do
   done =<< (runWriterT . flip evalStateT mempty) do
     cts' <- traverse (ABT.transformM goType) cts
@@ -740,19 +745,19 @@ c2sDecl saveText saveDefn (C.Decl.DataDeclaration dt m b cts) = do
       pure (ids, decl)
 
 -- | Unlocalize a decl.
-s2cDecl :: DB m => LocalIds -> S.Decl.Decl Symbol -> m (C.Decl Symbol)
+s2cDecl :: LocalIds -> S.Decl.Decl Symbol -> Transaction (C.Decl Symbol)
 s2cDecl ids (C.Decl.DataDeclaration dt m b ct) = do
   substTypeRef <- localIdsToTypeRefLookup ids
   pure (C.Decl.DataDeclaration dt m b (C.Type.rmap substTypeRef <$> ct))
 
-loadDeclByReference :: DB m => C.Reference.Id -> MaybeT m (C.Decl Symbol)
+loadDeclByReference :: C.Reference.Id -> MaybeT Transaction (C.Decl Symbol)
 loadDeclByReference r@(C.Reference.Id h i) = do
   when debug . traceM $ "loadDeclByReference " ++ show r
   oid <- MaybeT (Q.loadObjectIdForPrimaryHash h)
   (localIds, decl) <- MaybeT (Q.loadDeclObject oid (decodeDeclElement i))
-  s2cDecl localIds decl
+  lift (s2cDecl localIds decl)
 
-expectDeclByReference :: DB m => C.Reference.Id -> m (C.Decl Symbol)
+expectDeclByReference :: C.Reference.Id -> Transaction (C.Decl Symbol)
 expectDeclByReference r@(C.Reference.Id h i) = do
   when debug . traceM $ "expectDeclByReference " ++ show r
   -- retrieve the blob
@@ -762,7 +767,7 @@ expectDeclByReference r@(C.Reference.Id h i) = do
 
 -- * Branch transformation
 
-s2cBranch :: DB m => S.DbBranch -> m (C.Branch.Branch m)
+s2cBranch :: S.DbBranch -> Transaction (C.Branch.Branch Transaction)
 s2cBranch (S.Branch.Full.Branch tms tps patches children) =
   C.Branch.Branch
     <$> doTerms tms
@@ -770,15 +775,23 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) =
     <*> doPatches patches
     <*> doChildren children
   where
-    loadMetadataType :: DB m => S.Reference -> m C.Reference
+    loadMetadataType :: S.Reference -> Transaction C.Reference
     loadMetadataType = \case
       C.ReferenceBuiltin tId ->
         Q.expectTextCheck tId (Left . NeedTypeForBuiltinMetadata)
       C.ReferenceDerived id ->
         typeReferenceForTerm id >>= h2cReference
 
-    loadTypesForMetadata rs = Map.fromList <$> traverse (\r -> (,) <$> s2cReference r <*> loadMetadataType r) (Foldable.toList rs)
-    doTerms :: DB m => Map Db.TextId (Map S.Referent S.DbMetadataSet) -> m (Map C.Branch.NameSegment (Map C.Referent (m C.Branch.MdValues)))
+    loadTypesForMetadata :: Set S.Reference -> Transaction (Map C.Reference C.Reference)
+    loadTypesForMetadata rs =
+      Map.fromList
+        <$> traverse
+          (\r -> (,) <$> s2cReference r <*> loadMetadataType r)
+          (Foldable.toList rs)
+
+    doTerms ::
+      Map Db.TextId (Map S.Referent S.DbMetadataSet) ->
+      Transaction (Map C.Branch.NameSegment (Map C.Referent (Transaction C.Branch.MdValues)))
     doTerms =
       Map.bitraverse
         (fmap C.Branch.NameSegment . Q.expectText)
@@ -786,7 +799,9 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) =
             S.MetadataSet.Inline rs ->
               pure $ C.Branch.MdValues <$> loadTypesForMetadata rs
         )
-    doTypes :: DB m => Map Db.TextId (Map S.Reference S.DbMetadataSet) -> m (Map C.Branch.NameSegment (Map C.Reference (m C.Branch.MdValues)))
+    doTypes ::
+      Map Db.TextId (Map S.Reference S.DbMetadataSet) ->
+      Transaction (Map C.Branch.NameSegment (Map C.Reference (Transaction C.Branch.MdValues)))
     doTypes =
       Map.bitraverse
         (fmap C.Branch.NameSegment . Q.expectText)
@@ -794,38 +809,55 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) =
             S.MetadataSet.Inline rs ->
               pure $ C.Branch.MdValues <$> loadTypesForMetadata rs
         )
-    doPatches :: DB m => Map Db.TextId Db.PatchObjectId -> m (Map C.Branch.NameSegment (PatchHash, m C.Branch.Patch))
+    doPatches ::
+      Map Db.TextId Db.PatchObjectId ->
+      Transaction (Map C.Branch.NameSegment (PatchHash, Transaction C.Branch.Patch))
     doPatches = Map.bitraverse (fmap C.Branch.NameSegment . Q.expectText) \patchId -> do
       h <- PatchHash <$> (Q.expectPrimaryHashByObjectId . Db.unPatchObjectId) patchId
       pure (h, expectPatch patchId)
 
-    doChildren :: DB m => Map Db.TextId (Db.BranchObjectId, Db.CausalHashId) -> m (Map C.Branch.NameSegment (C.Causal m CausalHash BranchHash (C.Branch.Branch m)))
+    doChildren ::
+      Map Db.TextId (Db.BranchObjectId, Db.CausalHashId) ->
+      Transaction (Map C.Branch.NameSegment (C.Causal Transaction CausalHash BranchHash (C.Branch.Branch Transaction)))
     doChildren = Map.bitraverse (fmap C.Branch.NameSegment . Q.expectText) \(boId, chId) ->
       C.Causal <$> Q.expectCausalHash chId
         <*> expectValueHashByCausalHashId chId
         <*> headParents chId
         <*> pure (expectBranch boId)
       where
-        headParents :: DB m => Db.CausalHashId -> m (Map CausalHash (m (C.Causal m CausalHash BranchHash (C.Branch.Branch m))))
+        headParents ::
+          Db.CausalHashId ->
+          Transaction
+            ( Map
+                CausalHash
+                (Transaction (C.Causal Transaction CausalHash BranchHash (C.Branch.Branch Transaction)))
+            )
         headParents chId = do
           parentsChIds <- Q.loadCausalParents chId
           fmap Map.fromList $ traverse pairParent parentsChIds
-        pairParent :: DB m => Db.CausalHashId -> m (CausalHash, m (C.Causal m CausalHash BranchHash (C.Branch.Branch m)))
+        pairParent ::
+          Db.CausalHashId ->
+          Transaction
+            ( CausalHash,
+              Transaction (C.Causal Transaction CausalHash BranchHash (C.Branch.Branch Transaction))
+            )
         pairParent chId = do
           h <- Q.expectCausalHash chId
           pure (h, loadCausal chId)
-        loadCausal :: DB m => Db.CausalHashId -> m (C.Causal m CausalHash BranchHash (C.Branch.Branch m))
+        loadCausal ::
+          Db.CausalHashId ->
+          Transaction (C.Causal Transaction CausalHash BranchHash (C.Branch.Branch Transaction))
         loadCausal chId = do
           C.Causal <$> Q.expectCausalHash chId
             <*> expectValueHashByCausalHashId chId
             <*> headParents chId
             <*> pure (loadValue chId)
-        loadValue :: DB m => Db.CausalHashId -> m (C.Branch.Branch m)
+        loadValue :: Db.CausalHashId -> Transaction (C.Branch.Branch Transaction)
         loadValue chId = do
           boId <- Q.expectBranchObjectIdByCausalHashId chId
           expectBranch boId
 
-saveRootBranch :: DB m => C.Branch.Causal m -> m (Db.BranchObjectId, Db.CausalHashId)
+saveRootBranch :: C.Branch.Causal Transaction -> Transaction (Db.BranchObjectId, Db.CausalHashId)
 saveRootBranch c = do
   when debug $ traceM $ "Operations.saveRootBranch " ++ show (C.causalHash c)
   (boId, chId) <- saveBranch c
@@ -871,7 +903,7 @@ saveRootBranch c = do
 -- References, but also values
 -- Shallow - Hash? representation of the database relationships
 
-saveBranch :: DB m => C.Branch.Causal m -> m (Db.BranchObjectId, Db.CausalHashId)
+saveBranch :: C.Branch.Causal Transaction -> Transaction (Db.BranchObjectId, Db.CausalHashId)
 saveBranch (C.Causal hc he parents me) = do
   when debug $ traceM $ "\nOperations.saveBranch \n  hc = " ++ show hc ++ ",\n  he = " ++ show he ++ ",\n  parents = " ++ show (Map.keys parents)
 
@@ -898,7 +930,7 @@ saveBranch (C.Causal hc he parents me) = do
     saveBranchObject bhId li lBranch
   pure (boId, chId)
   where
-    c2sBranch :: DB m => C.Branch.Branch m -> m S.DbBranch
+    c2sBranch :: C.Branch.Branch Transaction -> Transaction S.DbBranch
     c2sBranch (C.Branch.Branch terms types patches children) =
       S.Branch
         <$> Map.bitraverse saveNameSegment (Map.bitraverse c2sReferent c2sMetadata) terms
@@ -906,15 +938,15 @@ saveBranch (C.Causal hc he parents me) = do
         <*> Map.bitraverse saveNameSegment savePatchObjectId patches
         <*> Map.bitraverse saveNameSegment saveBranch children
 
-    saveNameSegment :: DB m => C.Branch.NameSegment -> m Db.TextId
+    saveNameSegment :: C.Branch.NameSegment -> Transaction Db.TextId
     saveNameSegment = Q.saveText . C.Branch.unNameSegment
 
-    c2sMetadata :: DB m => m C.Branch.MdValues -> m S.Branch.Full.DbMetadataSet
+    c2sMetadata :: Transaction C.Branch.MdValues -> Transaction S.Branch.Full.DbMetadataSet
     c2sMetadata mm = do
       C.Branch.MdValues m <- mm
       S.Branch.Full.Inline <$> Set.traverse c2sReference (Map.keysSet m)
 
-    savePatchObjectId :: DB m => (PatchHash, m C.Branch.Patch) -> m Db.PatchObjectId
+    savePatchObjectId :: (PatchHash, Transaction C.Branch.Patch) -> Transaction Db.PatchObjectId
     savePatchObjectId (h, mp) = do
       Q.loadPatchObjectIdForPrimaryHash h >>= \case
         Just patchOID -> pure patchOID
@@ -922,23 +954,23 @@ saveBranch (C.Causal hc he parents me) = do
           patch <- mp
           savePatch h patch
 
-saveBranchObject :: DB m => Db.BranchHashId -> BranchLocalIds -> S.Branch.Full.LocalBranch -> m Db.BranchObjectId
+saveBranchObject :: Db.BranchHashId -> BranchLocalIds -> S.Branch.Full.LocalBranch -> Transaction Db.BranchObjectId
 saveBranchObject id@(Db.unBranchHashId -> hashId) li lBranch = do
   when debug $ traceM $ "saveBranchObject\n\tid = " ++ show id ++ "\n\tli = " ++ show li ++ "\n\tlBranch = " ++ show lBranch
   let bytes = S.putBytes S.putBranchFormat $ S.BranchFormat.Full li lBranch
   oId <- Q.saveObject hashId OT.Namespace bytes
   pure $ Db.BranchObjectId oId
 
-expectRootCausal :: DB m => m (C.Branch.Causal m)
+expectRootCausal :: Transaction (C.Branch.Causal Transaction)
 expectRootCausal = Q.expectNamespaceRoot >>= expectCausalByCausalHashId
 
-loadCausalBranchByCausalHash :: DB m => CausalHash -> m (Maybe (C.Branch.Causal m))
+loadCausalBranchByCausalHash :: CausalHash -> Transaction (Maybe (C.Branch.Causal Transaction))
 loadCausalBranchByCausalHash hc = do
   Q.loadCausalHashIdByCausalHash hc >>= \case
     Just chId -> Just <$> expectCausalByCausalHashId chId
     Nothing -> pure Nothing
 
-expectCausalByCausalHashId :: DB m => Db.CausalHashId -> m (C.Branch.Causal m)
+expectCausalByCausalHashId :: Db.CausalHashId -> Transaction (C.Branch.Causal Transaction)
 expectCausalByCausalHashId id = do
   hc <- Q.expectCausalHash id
   hb <- expectValueHashByCausalHashId id
@@ -948,30 +980,30 @@ expectCausalByCausalHashId id = do
     pure (h, expectCausalByCausalHashId hId)
   pure $ C.Causal hc hb (Map.fromList loadParents) (expectBranchByCausalHashId id)
 
-expectBranchByCausalHashId :: DB m => Db.CausalHashId -> m (C.Branch.Branch m)
+expectBranchByCausalHashId :: Db.CausalHashId -> Transaction (C.Branch.Branch Transaction)
 expectBranchByCausalHashId id = do
   boId <- Q.expectBranchObjectIdByCausalHashId id
   expectBranch boId
 
-expectDbBranch :: DB m => Db.BranchObjectId -> m S.DbBranch
+expectDbBranch :: Db.BranchObjectId -> Transaction S.DbBranch
 expectDbBranch id =
   deserializeBranchObject id >>= \case
     S.BranchFormat.Full li f -> pure (S.BranchFormat.localToDbBranch li f)
     S.BranchFormat.Diff r li d -> doDiff r [S.BranchFormat.localToDbDiff li d]
   where
-    deserializeBranchObject :: DB m => Db.BranchObjectId -> m S.BranchFormat
+    deserializeBranchObject :: Db.BranchObjectId -> Transaction S.BranchFormat
     deserializeBranchObject id = do
       when debug $ traceM $ "deserializeBranchObject " ++ show id
       Q.expectNamespaceObject (Db.unBranchObjectId id) decodeBranchFormat
 
-    doDiff :: DB m => Db.BranchObjectId -> [S.Branch.Diff] -> m S.DbBranch
+    doDiff :: Db.BranchObjectId -> [S.Branch.Diff] -> Transaction S.DbBranch
     doDiff ref ds =
       deserializeBranchObject ref >>= \case
-        S.BranchFormat.Full li f -> joinFull (S.BranchFormat.localToDbBranch li f) ds
+        S.BranchFormat.Full li f -> pure (joinFull (S.BranchFormat.localToDbBranch li f) ds)
         S.BranchFormat.Diff ref' li' d' -> doDiff ref' (S.BranchFormat.localToDbDiff li' d' : ds)
       where
-        joinFull :: DB m => S.DbBranch -> [S.Branch.Diff] -> m S.DbBranch
-        joinFull f [] = pure f
+        joinFull :: S.DbBranch -> [S.Branch.Diff] -> S.DbBranch
+        joinFull f [] = f
         joinFull
           (S.Branch.Full.Branch tms tps patches children)
           (S.Branch.Diff tms' tps' patches' children' : ds) = joinFull f' ds
@@ -1059,58 +1091,58 @@ expectDbBranch id =
             let (Set.fromList -> adds, Set.fromList -> removes) = S.BranchDiff.addsRemoves md'
              in Just . S.MetadataSet.Inline $ (Set.union adds $ Set.difference md removes)
 
-expectBranch :: DB m => Db.BranchObjectId -> m (C.Branch.Branch m)
+expectBranch :: Db.BranchObjectId -> Transaction (C.Branch.Branch Transaction)
 expectBranch id =
   expectDbBranch id >>= s2cBranch
 
 -- * Patch transformation
 
-expectPatch :: DB m => Db.PatchObjectId -> m C.Branch.Patch
+expectPatch :: Db.PatchObjectId -> Transaction C.Branch.Patch
 expectPatch patchId =
   expectDbPatch patchId >>= s2cPatch
 
-expectDbPatch :: DB m => Db.PatchObjectId -> m S.Patch
+expectDbPatch :: Db.PatchObjectId -> Transaction S.Patch
 expectDbPatch patchId =
   deserializePatchObject patchId >>= \case
     S.Patch.Format.Full li p -> pure (S.Patch.Format.localPatchToPatch li p)
     S.Patch.Format.Diff ref li d -> doDiff ref [S.Patch.Format.localPatchDiffToPatchDiff li d]
   where
-    doDiff :: DB m => Db.PatchObjectId -> [S.PatchDiff] -> m S.Patch
+    doDiff :: Db.PatchObjectId -> [S.PatchDiff] -> Transaction S.Patch
     doDiff ref ds =
       deserializePatchObject ref >>= \case
         S.Patch.Format.Full li f -> pure (S.Patch.Format.applyPatchDiffs (S.Patch.Format.localPatchToPatch li f) ds)
         S.Patch.Format.Diff ref' li' d' -> doDiff ref' (S.Patch.Format.localPatchDiffToPatchDiff li' d' : ds)
 
-savePatch :: DB m => PatchHash -> C.Branch.Patch -> m Db.PatchObjectId
+savePatch :: PatchHash -> C.Branch.Patch -> Transaction Db.PatchObjectId
 savePatch h c = do
   (li, lPatch) <- LocalizeObject.localizePatch <$> c2sPatch c
   saveDbPatch h (S.Patch.Format.Full li lPatch)
 
-saveDbPatch :: DB m => PatchHash -> S.PatchFormat -> m Db.PatchObjectId
+saveDbPatch :: PatchHash -> S.PatchFormat -> Transaction Db.PatchObjectId
 saveDbPatch hash patch = do
   hashId <- Q.saveHashHash (unPatchHash hash)
   let bytes = S.putBytes S.putPatchFormat patch
   Db.PatchObjectId <$> Q.saveObject hashId OT.Patch bytes
 
-s2cPatch :: DB m => S.Patch -> m C.Branch.Patch
+s2cPatch :: S.Patch -> Transaction C.Branch.Patch
 s2cPatch (S.Patch termEdits typeEdits) =
   C.Branch.Patch
     <$> Map.bitraverse h2cReferent (Set.traverse s2cTermEdit) termEdits
     <*> Map.bitraverse h2cReference (Set.traverse s2cTypeEdit) typeEdits
 
-deserializePatchObject :: DB m => Db.PatchObjectId -> m S.PatchFormat
+deserializePatchObject :: Db.PatchObjectId -> Transaction S.PatchFormat
 deserializePatchObject id = do
   when debug $ traceM $ "Operations.deserializePatchObject " ++ show id
   Q.expectPatchObject (Db.unPatchObjectId id) decodePatchFormat
 
-lca :: DB m => CausalHash -> CausalHash -> Connection -> Connection -> m (Maybe CausalHash)
+lca :: CausalHash -> CausalHash -> Connection -> Connection -> Transaction (Maybe CausalHash)
 lca h1 h2 c1 c2 = runMaybeT do
   chId1 <- MaybeT $ Q.loadCausalHashIdByCausalHash h1
   chId2 <- MaybeT $ Q.loadCausalHashIdByCausalHash h2
-  chId3 <- MaybeT . liftIO $ Q.lca chId1 chId2 c1 c2
-  Q.expectCausalHash chId3
+  chId3 <- MaybeT . idempotentIO $ Q.lca chId1 chId2 c1 c2
+  lift (Q.expectCausalHash chId3)
 
-before :: DB m => CausalHash -> CausalHash -> m (Maybe Bool)
+before :: CausalHash -> CausalHash -> Transaction (Maybe Bool)
 before h1 h2 = runMaybeT do
   chId2 <- MaybeT $ Q.loadCausalHashIdByCausalHash h2
   lift (Q.loadCausalHashIdByCausalHash h1) >>= \case
@@ -1119,76 +1151,75 @@ before h1 h2 = runMaybeT do
 
 -- * Searches
 
-termsHavingType :: DB m => C.Reference -> m (Set C.Referent.Id)
-termsHavingType cTypeRef = do
-  maySet <- runMaybeT $ do
-    sTypeRef <- c2hReference cTypeRef
-    sIds <- Q.getReferentsByType sTypeRef
-    traverse s2cReferentId sIds
-  pure case maySet of
-    Nothing -> mempty
-    Just set -> Set.fromList set
+termsHavingType :: C.Reference -> Transaction (Set C.Referent.Id)
+termsHavingType cTypeRef =
+  runMaybeT (c2hReference cTypeRef) >>= \case
+    Nothing -> pure Set.empty
+    Just sTypeRef -> do
+      sIds <- Q.getReferentsByType sTypeRef
+      set <- traverse s2cReferentId sIds
+      pure (Set.fromList set)
 
-typeReferenceForTerm :: DB m => S.Reference.Id -> m S.ReferenceH
+typeReferenceForTerm :: S.Reference.Id -> Transaction S.ReferenceH
 typeReferenceForTerm = Q.getTypeReferenceForReferent . C.Referent.RefId
 
-termsMentioningType :: DB m => C.Reference -> m (Set C.Referent.Id)
-termsMentioningType cTypeRef = do
-  maySet <- runMaybeT $ do
-    sTypeRef <- c2hReference cTypeRef
-    sIds <- Q.getReferentsByTypeMention sTypeRef
-    traverse s2cReferentId sIds
-  pure case maySet of
-    Nothing -> mempty
-    Just set -> Set.fromList set
+termsMentioningType :: C.Reference -> Transaction (Set C.Referent.Id)
+termsMentioningType cTypeRef =
+  runMaybeT (c2hReference cTypeRef) >>= \case
+    Nothing -> pure Set.empty
+    Just sTypeRef -> do
+      sIds <- Q.getReferentsByTypeMention sTypeRef
+      set <- traverse s2cReferentId sIds
+      pure (Set.fromList set)
 
-addTypeToIndexForTerm :: DB m => S.Referent.Id -> C.Reference -> m ()
+addTypeToIndexForTerm :: S.Referent.Id -> C.Reference -> Transaction ()
 addTypeToIndexForTerm sTermId cTypeRef = do
   sTypeRef <- saveReferenceH cTypeRef
   Q.addToTypeIndex sTypeRef sTermId
 
-addTypeMentionsToIndexForTerm :: DB m => S.Referent.Id -> Set C.Reference -> m ()
+addTypeMentionsToIndexForTerm :: S.Referent.Id -> Set C.Reference -> Transaction ()
 addTypeMentionsToIndexForTerm sTermId cTypeMentionRefs = do
   traverse_ (flip Q.addToTypeMentionsIndex sTermId <=< saveReferenceH) cTypeMentionRefs
 
 -- something kind of funny here.  first, we don't need to enumerate all the reference pos if we're just picking one
 -- second, it would be nice if we could leave these as S.References a little longer
 -- so that we remember how to blow up if they're missing
-componentReferencesByPrefix :: DB m => OT.ObjectType -> Text -> Maybe C.Reference.Pos -> m [S.Reference.Id]
+componentReferencesByPrefix :: OT.ObjectType -> Text -> Maybe C.Reference.Pos -> Transaction [S.Reference.Id]
 componentReferencesByPrefix ot b32prefix pos = do
   oIds :: [Db.ObjectId] <- Q.objectIdByBase32Prefix ot b32prefix
   let test = maybe (const True) (==) pos
   let filterComponent l = [x | x@(C.Reference.Id _ pos) <- l, test pos]
-  fmap Monoid.fromMaybe . runMaybeT $
-    join <$> traverse (fmap filterComponent . componentByObjectId) oIds
+  join <$> traverse (fmap filterComponent . componentByObjectId) oIds
 
-termReferencesByPrefix :: DB m => Text -> Maybe Word64 -> m [C.Reference.Id]
+termReferencesByPrefix :: Text -> Maybe Word64 -> Transaction [C.Reference.Id]
 termReferencesByPrefix t w =
   componentReferencesByPrefix OT.TermComponent t w
     >>= traverse (C.Reference.idH Q.expectPrimaryHashByObjectId)
 
-declReferencesByPrefix :: DB m => Text -> Maybe Word64 -> m [C.Reference.Id]
+declReferencesByPrefix :: Text -> Maybe Word64 -> Transaction [C.Reference.Id]
 declReferencesByPrefix t w =
   componentReferencesByPrefix OT.DeclComponent t w
     >>= traverse (C.Reference.idH Q.expectPrimaryHashByObjectId)
 
-termReferentsByPrefix :: DB m => Text -> Maybe Word64 -> m [C.Referent.Id]
+termReferentsByPrefix :: Text -> Maybe Word64 -> Transaction [C.Referent.Id]
 termReferentsByPrefix b32prefix pos =
   fmap C.Referent.RefId <$> termReferencesByPrefix b32prefix pos
 
 -- todo: simplify this if we stop caring about constructor type
 -- todo: remove the cycle length once we drop it from Unison.Reference
 declReferentsByPrefix ::
-  DB m =>
   Text ->
   Maybe C.Reference.Pos ->
   Maybe ConstructorId ->
-  m [(H.Hash, C.Reference.Pos, C.DeclType, [C.Decl.ConstructorId])]
+  Transaction [(H.Hash, C.Reference.Pos, C.DeclType, [C.Decl.ConstructorId])]
 declReferentsByPrefix b32prefix pos cid = do
   componentReferencesByPrefix OT.DeclComponent b32prefix pos
     >>= traverse (loadConstructors cid)
   where
-    loadConstructors :: DB m => Maybe Word64 -> S.Reference.Id -> m (H.Hash, C.Reference.Pos, C.DeclType, [ConstructorId])
+    loadConstructors ::
+      Maybe Word64 ->
+      S.Reference.Id ->
+      Transaction (H.Hash, C.Reference.Pos, C.DeclType, [ConstructorId])
     loadConstructors cid rid@(C.Reference.Id oId pos) = do
       (dt, ctorCount) <- getDeclCtorCount rid
       h <- Q.expectPrimaryHashByObjectId oId
@@ -1196,26 +1227,26 @@ declReferentsByPrefix b32prefix pos cid = do
           test = maybe (const True) (==) cid
           cids = [cid | cid <- [0 :: ConstructorId .. ctorCount - 1], test cid]
       pure (h, pos, dt, cids)
-    getDeclCtorCount :: DB m => S.Reference.Id -> m (C.Decl.DeclType, ConstructorId)
+    getDeclCtorCount :: S.Reference.Id -> Transaction (C.Decl.DeclType, ConstructorId)
     getDeclCtorCount id@(C.Reference.Id r i) = do
       when debug $ traceM $ "getDeclCtorCount " ++ show id
       (_localIds, decl) <- Q.expectDeclObject r (decodeDeclElement i)
       pure (C.Decl.declType decl, fromIntegral $ length (C.Decl.constructorTypes decl))
 
-branchHashesByPrefix :: DB m => ShortBranchHash -> m (Set BranchHash)
+branchHashesByPrefix :: ShortBranchHash -> Transaction (Set BranchHash)
 branchHashesByPrefix (ShortBranchHash b32prefix) = do
   hashIds <- Q.namespaceHashIdByBase32Prefix b32prefix
   hashes <- traverse (Q.expectHash . Db.unBranchHashId) hashIds
   pure $ Set.fromList . map BranchHash $ hashes
 
-causalHashesByPrefix :: DB m => ShortBranchHash -> m (Set CausalHash)
+causalHashesByPrefix :: ShortBranchHash -> Transaction (Set CausalHash)
 causalHashesByPrefix (ShortBranchHash b32prefix) = do
   hashIds <- Q.causalHashIdByBase32Prefix b32prefix
   hashes <- traverse (Q.expectHash . Db.unCausalHashId) hashIds
   pure $ Set.fromList . map CausalHash $ hashes
 
 -- | returns a list of known definitions referencing `r`
-dependents :: DB m => C.Reference -> m (Set C.Reference.Id)
+dependents :: C.Reference -> Transaction (Set C.Reference.Id)
 dependents r = do
   r' <- c2sReference r
   sIds :: [S.Reference.Id] <- Q.getDependentsForDependency r'
@@ -1223,7 +1254,7 @@ dependents r = do
   pure $ Set.fromList cIds
 
 -- | returns a list of known definitions referencing `h`
-dependentsOfComponent :: DB m => H.Hash -> m (Set C.Reference.Id)
+dependentsOfComponent :: H.Hash -> Transaction (Set C.Reference.Id)
 dependentsOfComponent h = do
   oId <- Q.expectObjectIdForPrimaryHash h
   sIds :: [S.Reference.Id] <- Q.getDependentsForDependencyComponent oId
@@ -1231,7 +1262,7 @@ dependentsOfComponent h = do
   pure $ Set.fromList cIds
 
 -- | returns empty set for unknown inputs; doesn't distinguish between term and decl
-derivedDependencies :: DB m => C.Reference.Id -> m (Set C.Reference.Id)
+derivedDependencies :: C.Reference.Id -> Transaction (Set C.Reference.Id)
 derivedDependencies cid = do
   sid <- c2sReferenceId cid
   sids <- Q.getDependencyIdsForDependent sid

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

@@ -117,7 +117,6 @@ module U.Codebase.Sqlite.Queries
     causalHashIdByBase32Prefix,
 
     -- * garbage collection
-    vacuum,
     garbageCollectObjectsWithoutHashes,
     garbageCollectWatchesWithoutObjects,
 
@@ -125,11 +124,9 @@ module U.Codebase.Sqlite.Queries
     createSchema,
     schemaVersion,
     setSchemaVersion,
-    vacuumInto,
   )
 where
 
-import qualified Data.List.Extra as List
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as Nel
 import qualified Data.Set as Set
@@ -158,119 +155,111 @@ import qualified U.Util.Alternative as Alternative
 import U.Util.Base32Hex (Base32Hex (..))
 import U.Util.Hash (Hash)
 import qualified U.Util.Hash as Hash
-import Unison.Sqlite
-import qualified Unison.Sqlite.DB as DB
-import qualified Unison.Sqlite.Transaction as Transaction
 import Unison.Prelude
+import Unison.Sqlite
 
 -- * main squeeze
 
-createSchema :: (DB m, MonadUnliftIO m) => m ()
+createSchema :: Transaction ()
 createSchema =
-  DB.runTransaction do
-    traverse_ (Transaction.execute_ . fromString) $ List.splitOn ";" [hereFile|sql/create.sql|]
+  execute_ [hereFile|sql/create.sql|]
 
--- | Copy the database into the specified location, performing a VACUUM in the process.
-vacuumInto :: DB m => FilePath -> m ()
-vacuumInto dest = do
-  execute "VACUUM INTO ?" [dest]
-
-schemaVersion :: DB m => m SchemaVersion
+schemaVersion :: Transaction SchemaVersion
 schemaVersion = queryOneCol_ sql
   where
     sql = "SELECT version from schema_version;"
 
-setSchemaVersion :: DB m => SchemaVersion -> m ()
+setSchemaVersion :: SchemaVersion -> Transaction ()
 setSchemaVersion schemaVersion = execute sql (Only schemaVersion)
   where
     sql = "UPDATE schema_version SET version = ?"
 
 {- ORMOLU_DISABLE -}
 {- Please don't try to format the SQL blocks —AI -}
-countObjects :: DB m => m Int
+countObjects :: Transaction Int
 countObjects = queryOneCol_ [here| SELECT COUNT(*) FROM object |]
 
-countCausals :: DB m => m Int
+countCausals :: Transaction Int
 countCausals = queryOneCol_ [here| SELECT COUNT(*) FROM causal |]
 
-countWatches :: DB m => m Int
+countWatches :: Transaction Int
 countWatches = queryOneCol_ [here| SELECT COUNT(*) FROM watch |]
 
-saveHash :: DB m => Base32Hex -> m HashId
+saveHash :: Base32Hex -> Transaction HashId
 saveHash base32 = execute sql (Only base32) >> expectHashId base32
   where sql = [here|
     INSERT INTO hash (base32) VALUES (?)
     ON CONFLICT DO NOTHING
   |]
 
-saveHashHash :: DB m => Hash -> m HashId
+saveHashHash :: Hash -> Transaction HashId
 saveHashHash = saveHash . Hash.toBase32Hex
 
-loadHashId :: DB m => Base32Hex -> m (Maybe HashId)
+loadHashId :: Base32Hex -> Transaction (Maybe HashId)
 loadHashId base32 = queryMaybeCol loadHashIdSql (Only base32)
 
-expectHashId :: DB m => Base32Hex -> m HashId
+expectHashId :: Base32Hex -> Transaction HashId
 expectHashId base32 = queryOneCol loadHashIdSql (Only base32)
 
 loadHashIdSql :: Sql
 loadHashIdSql =
   [here| SELECT id FROM hash WHERE base32 = ? |]
 
-loadHashIdByHash :: DB m => Hash -> m (Maybe HashId)
+loadHashIdByHash :: Hash -> Transaction (Maybe HashId)
 loadHashIdByHash = loadHashId . Hash.toBase32Hex
 
-saveCausalHash :: DB m => CausalHash -> m CausalHashId
+saveCausalHash :: CausalHash -> Transaction CausalHashId
 saveCausalHash = fmap CausalHashId . saveHashHash . unCausalHash
 
-saveBranchHash :: DB m => BranchHash -> m BranchHashId
+saveBranchHash :: BranchHash -> Transaction BranchHashId
 saveBranchHash = fmap BranchHashId . saveHashHash . unBranchHash
 
-loadCausalHashIdByCausalHash :: DB m => CausalHash -> m (Maybe CausalHashId)
+loadCausalHashIdByCausalHash :: CausalHash -> Transaction (Maybe CausalHashId)
 loadCausalHashIdByCausalHash ch = runMaybeT do
   hId <- MaybeT $ loadHashIdByHash (unCausalHash ch)
-  Alternative.whenM (isCausalHash hId) (CausalHashId hId)
+  Alternative.whenM (lift (isCausalHash hId)) (CausalHashId hId)
 
-loadCausalByCausalHash :: DB m => CausalHash -> m (Maybe (CausalHashId, BranchHashId))
+loadCausalByCausalHash :: CausalHash -> Transaction (Maybe (CausalHashId, BranchHashId))
 loadCausalByCausalHash ch = runMaybeT do
   hId <- MaybeT $ loadHashIdByHash (unCausalHash ch)
   bhId <- MaybeT $ loadCausalValueHashId hId
   pure (CausalHashId hId, bhId)
 
-expectHashIdByHash :: DB m => Hash -> m HashId
+expectHashIdByHash :: Hash -> Transaction HashId
 expectHashIdByHash = expectHashId . Hash.toBase32Hex
 
-expectHash :: DB m => HashId -> m Hash
+expectHash :: HashId -> Transaction Hash
 expectHash h = Hash.fromBase32Hex <$> expectHash32 h
 
-expectHash32 :: DB m => HashId -> m Base32Hex
+expectHash32 :: HashId -> Transaction Base32Hex
 expectHash32 h = queryOneCol sql (Only h)
   where sql = [here| SELECT base32 FROM hash WHERE id = ? |]
 
-saveText :: DB m => Text -> m TextId
+saveText :: Text -> Transaction TextId
 saveText t = execute sql (Only t) >> expectTextId t
   where sql = [here| INSERT INTO text (text) VALUES (?) ON CONFLICT DO NOTHING|]
 
-loadTextId :: DB m => Text -> m (Maybe TextId)
+loadTextId :: Text -> Transaction (Maybe TextId)
 loadTextId t = queryMaybeCol loadTextIdSql (Only t)
 
-expectTextId :: DB m => Text -> m TextId
+expectTextId :: Text -> Transaction TextId
 expectTextId t = queryOneCol loadTextIdSql (Only t)
 
 loadTextIdSql :: Sql
 loadTextIdSql =
   [here| SELECT id FROM text WHERE text = ? |]
 
-expectText :: DB m => TextId -> m Text
+expectText :: TextId -> Transaction Text
 expectText h = queryOneCol loadTextSql (Only h)
 
-expectTextCheck :: (DB m, SqliteExceptionReason e) => TextId -> (Text -> Either e a) -> m a
+expectTextCheck :: SqliteExceptionReason e => TextId -> (Text -> Either e a) -> Transaction a
 expectTextCheck h = queryOneColCheck loadTextSql (Only h)
 
 loadTextSql :: Sql
 loadTextSql =
   [here| SELECT text FROM text WHERE id = ? |]
 
-saveHashObject :: DB m => HashId -> ObjectId -> HashVersion -> m ()
+saveHashObject :: HashId -> ObjectId -> HashVersion -> Transaction ()
 saveHashObject hId oId version = execute sql (hId, oId, version) where
   sql = [here|
     INSERT INTO hash_object (hash_id, object_id, hash_version)
@@ -278,7 +267,7 @@ saveHashObject hId oId version = execute sql (hId, oId, version) where
     ON CONFLICT DO NOTHING
   |]
 
-saveObject :: DB m => HashId -> ObjectType -> ByteString -> m ObjectId
+saveObject :: HashId -> ObjectType -> ByteString -> Transaction ObjectId
 saveObject h t blob = do
   oId <- execute sql (h, t, blob) >> 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
@@ -290,7 +279,7 @@ saveObject h t blob = do
     ON CONFLICT DO NOTHING
   |]
 
-expectObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m a
+expectObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a
 expectObject oId check = do
  result <- queryOneColCheck sql (Only oId) check
  pure result
@@ -299,15 +288,15 @@ expectObject oId check = do
 |]
 
 loadObjectOfType ::
-  (DB m, SqliteExceptionReason e) =>
+  SqliteExceptionReason e =>
   ObjectId ->
   ObjectType ->
   (ByteString -> Either e a) ->
-  m (Maybe a)
+  Transaction (Maybe a)
 loadObjectOfType oid ty =
   queryMaybeColCheck loadObjectOfTypeSql (oid, ty)
 
-expectObjectOfType :: (DB m, SqliteExceptionReason e) => ObjectId -> ObjectType -> (ByteString -> Either e a) -> m a
+expectObjectOfType :: SqliteExceptionReason e => ObjectId -> ObjectType -> (ByteString -> Either e a) -> Transaction a
 expectObjectOfType oid ty =
   queryOneColCheck loadObjectOfTypeSql (oid, ty)
 
@@ -321,57 +310,57 @@ loadObjectOfTypeSql =
   |]
 
 -- | Load a decl component object.
-loadDeclObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m (Maybe a)
+loadDeclObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
 loadDeclObject oid =
   loadObjectOfType oid DeclComponent
 
 -- | Expect a decl component object.
-expectDeclObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m a
+expectDeclObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a
 expectDeclObject oid =
   expectObjectOfType oid DeclComponent
 
 -- | Load a namespace object.
-loadNamespaceObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m (Maybe a)
+loadNamespaceObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
 loadNamespaceObject oid =
   loadObjectOfType oid Namespace
 
 -- | Expect a namespace object.
-expectNamespaceObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m a
+expectNamespaceObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a
 expectNamespaceObject oid =
   expectObjectOfType oid Namespace
 
 -- | Load a patch object.
-loadPatchObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m (Maybe a)
+loadPatchObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
 loadPatchObject oid =
   loadObjectOfType oid Patch
 
 -- | Expect a patch object.
-expectPatchObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m a
+expectPatchObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a
 expectPatchObject oid =
   expectObjectOfType oid Patch
 
 -- | Load a term component object.
-loadTermObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m (Maybe a)
+loadTermObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
 loadTermObject oid =
   loadObjectOfType oid TermComponent
 
 -- | Expect a term component object.
-expectTermObject :: (DB m, SqliteExceptionReason e) => ObjectId -> (ByteString -> Either e a) -> m a
+expectTermObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a
 expectTermObject oid =
   expectObjectOfType oid TermComponent
 
-expectObjectWithHashIdAndType :: DB m => ObjectId -> m (HashId, ObjectType, ByteString)
+expectObjectWithHashIdAndType :: ObjectId -> Transaction (HashId, ObjectType, ByteString)
 expectObjectWithHashIdAndType oId = queryOneRow sql (Only oId)
   where sql = [here|
     SELECT primary_hash_id, type_id, bytes FROM object WHERE id = ?
   |]
 
-loadObjectIdForPrimaryHashId :: DB m => HashId -> m (Maybe ObjectId)
+loadObjectIdForPrimaryHashId :: HashId -> Transaction (Maybe ObjectId)
 loadObjectIdForPrimaryHashId h =
   queryMaybeCol loadObjectIdForPrimaryHashIdSql (Only h)
 
 -- | Not all hashes have corresponding objects; e.g., hashes of term types
-expectObjectIdForPrimaryHashId :: DB m => HashId -> m ObjectId
+expectObjectIdForPrimaryHashId :: HashId -> Transaction ObjectId
 expectObjectIdForPrimaryHashId h =
   queryOneCol loadObjectIdForPrimaryHashIdSql (Only h)
 
@@ -383,32 +372,32 @@ loadObjectIdForPrimaryHashIdSql =
     WHERE primary_hash_id = ?
   |]
 
-loadObjectIdForPrimaryHash :: DB m => Hash -> m (Maybe ObjectId)
+loadObjectIdForPrimaryHash :: Hash -> Transaction (Maybe ObjectId)
 loadObjectIdForPrimaryHash h =
   loadHashIdByHash h >>= \case
     Nothing -> pure Nothing
     Just hashId -> loadObjectIdForPrimaryHashId hashId
 
-expectObjectIdForPrimaryHash :: DB m => Hash -> m ObjectId
+expectObjectIdForPrimaryHash :: Hash -> Transaction ObjectId
 expectObjectIdForPrimaryHash h = do
   hashId <- expectHashIdByHash h
   expectObjectIdForPrimaryHashId hashId
 
-loadPatchObjectIdForPrimaryHash :: DB m => PatchHash -> m (Maybe PatchObjectId)
+loadPatchObjectIdForPrimaryHash :: PatchHash -> Transaction (Maybe PatchObjectId)
 loadPatchObjectIdForPrimaryHash =
   (fmap . fmap) PatchObjectId . loadObjectIdForPrimaryHash . unPatchHash
 
-loadObjectIdForAnyHash :: DB m => Hash -> m (Maybe ObjectId)
+loadObjectIdForAnyHash :: Hash -> Transaction (Maybe ObjectId)
 loadObjectIdForAnyHash h =
   loadHashIdByHash h >>= \case
     Nothing -> pure Nothing
     Just hashId -> loadObjectIdForAnyHashId hashId
 
-loadObjectIdForAnyHashId :: DB m => HashId -> m (Maybe ObjectId)
+loadObjectIdForAnyHashId :: HashId -> Transaction (Maybe ObjectId)
 loadObjectIdForAnyHashId h =
   queryMaybeCol loadObjectIdForAnyHashIdSql (Only h)
 
-expectObjectIdForAnyHashId :: DB m => HashId -> m ObjectId
+expectObjectIdForAnyHashId :: HashId -> Transaction ObjectId
 expectObjectIdForAnyHashId h =
   queryOneCol loadObjectIdForAnyHashIdSql (Only h)
 
@@ -417,11 +406,11 @@ loadObjectIdForAnyHashIdSql =
   [here| SELECT object_id FROM hash_object WHERE hash_id = ? |]
 
 -- | All objects have corresponding hashes.
-expectPrimaryHashByObjectId :: DB m => ObjectId -> m Hash
+expectPrimaryHashByObjectId :: ObjectId -> Transaction Hash
 expectPrimaryHashByObjectId =
   fmap Hash.fromBase32Hex . expectPrimaryHash32ByObjectId
 
-expectPrimaryHash32ByObjectId :: DB m => ObjectId -> m Base32Hex
+expectPrimaryHash32ByObjectId :: ObjectId -> Transaction Base32Hex
 expectPrimaryHash32ByObjectId oId = queryOneCol sql (Only oId)
  where sql = [here|
   SELECT hash.base32
@@ -429,7 +418,7 @@ expectPrimaryHash32ByObjectId oId = queryOneCol sql (Only oId)
   WHERE object.id = ?
 |]
 
-expectHashIdsForObject :: DB m => ObjectId -> m (NonEmpty HashId)
+expectHashIdsForObject :: ObjectId -> Transaction (NonEmpty HashId)
 expectHashIdsForObject oId = do
   primaryHashId <- queryOneCol sql1 (Only oId)
   hashIds <- queryListCol sql2 (Only oId)
@@ -438,7 +427,7 @@ expectHashIdsForObject oId = do
     sql1 = "SELECT primary_hash_id FROM object WHERE id = ?"
     sql2 = "SELECT hash_id FROM hash_object WHERE object_id = ?"
 
-hashIdWithVersionForObject :: DB m => ObjectId -> m [(HashId, HashVersion)]
+hashIdWithVersionForObject :: ObjectId -> Transaction [(HashId, HashVersion)]
 hashIdWithVersionForObject = queryListRow sql . Only where sql = [here|
   SELECT hash_id, hash_version FROM hash_object WHERE object_id = ?
 |]
@@ -446,7 +435,7 @@ hashIdWithVersionForObject = queryListRow sql . Only where sql = [here|
 -- | @recordObjectRehash old new@ records that object @old@ was rehashed and inserted as a new object, @new@.
 --
 -- This function rewrites @old@'s @hash_object@ rows in place to point at the new object.
-recordObjectRehash :: DB m => ObjectId -> ObjectId -> m ()
+recordObjectRehash :: ObjectId -> ObjectId -> Transaction ()
 recordObjectRehash old new =
   execute sql (new, old)
   where
@@ -458,7 +447,7 @@ recordObjectRehash old new =
 
 -- |Maybe we would generalize this to something other than NamespaceHash if we
 -- end up wanting to store other kinds of Causals here too.
-saveCausal :: DB m => CausalHashId -> BranchHashId -> m ()
+saveCausal :: CausalHashId -> BranchHashId -> Transaction ()
 saveCausal self value = execute sql (self, value) where sql = [here|
   INSERT INTO causal (self_hash_id, value_hash_id)
   VALUES (?, ?)
@@ -482,14 +471,14 @@ saveCausal self value = execute sql (self, value) where sql = [here|
 --     SELECT MAX(gc_generation) FROM causal;
 --   |]
 
-expectCausalValueHashId :: DB m => CausalHashId -> m BranchHashId
+expectCausalValueHashId :: CausalHashId -> Transaction BranchHashId
 expectCausalValueHashId (CausalHashId id) =
   queryOneCol loadCausalValueHashIdSql (Only id)
 
-expectCausalHash :: DB m => CausalHashId -> m CausalHash
+expectCausalHash :: CausalHashId -> Transaction CausalHash
 expectCausalHash (CausalHashId id) = CausalHash <$> expectHash id
 
-loadCausalValueHashId :: DB m => HashId -> m (Maybe BranchHashId)
+loadCausalValueHashId :: HashId -> Transaction (Maybe BranchHashId)
 loadCausalValueHashId id =
   queryMaybeCol loadCausalValueHashIdSql (Only id)
 
@@ -497,15 +486,15 @@ loadCausalValueHashIdSql :: Sql
 loadCausalValueHashIdSql =
   [here| SELECT value_hash_id FROM causal WHERE self_hash_id = ? |]
 
-isCausalHash :: DB m => HashId -> m Bool
+isCausalHash :: HashId -> Transaction Bool
 isCausalHash = queryOneCol sql . Only where sql = [here|
     SELECT EXISTS (SELECT 1 FROM causal WHERE self_hash_id = ?)
   |]
 
-loadBranchObjectIdByCausalHashId :: DB m => CausalHashId -> m (Maybe BranchObjectId)
+loadBranchObjectIdByCausalHashId :: CausalHashId -> Transaction (Maybe BranchObjectId)
 loadBranchObjectIdByCausalHashId id = queryMaybeCol loadBranchObjectIdByCausalHashIdSql (Only id)
 
-expectBranchObjectIdByCausalHashId :: DB m => CausalHashId -> m BranchObjectId
+expectBranchObjectIdByCausalHashId :: CausalHashId -> Transaction BranchObjectId
 expectBranchObjectIdByCausalHashId id = queryOneCol loadBranchObjectIdByCausalHashIdSql (Only id)
 
 loadBranchObjectIdByCausalHashIdSql :: Sql
@@ -516,23 +505,23 @@ loadBranchObjectIdByCausalHashIdSql =
     WHERE causal.self_hash_id = ?
   |]
 
-saveCausalParents :: DB m => CausalHashId -> [CausalHashId] -> m ()
+saveCausalParents :: CausalHashId -> [CausalHashId] -> Transaction ()
 saveCausalParents child parents = executeMany sql $ (child,) <$> parents where
   sql = [here|
     INSERT INTO causal_parent (causal_id, parent_id) VALUES (?, ?)
     ON CONFLICT DO NOTHING
   |]
 
-loadCausalParents :: DB m => CausalHashId -> m [CausalHashId]
+loadCausalParents :: CausalHashId -> Transaction [CausalHashId]
 loadCausalParents h = queryListCol sql (Only h) where sql = [here|
   SELECT parent_id FROM causal_parent WHERE causal_id = ?
 |]
 
-expectNamespaceRoot :: DB m => m CausalHashId
+expectNamespaceRoot :: Transaction CausalHashId
 expectNamespaceRoot =
   queryOneCol_ loadNamespaceRootSql
 
-loadNamespaceRoot :: DB m => m (Maybe CausalHashId)
+loadNamespaceRoot :: Transaction (Maybe CausalHashId)
 loadNamespaceRoot =
   queryMaybeCol_ loadNamespaceRootSql
 
@@ -543,7 +532,7 @@ loadNamespaceRootSql =
     FROM namespace_root
   |]
 
-setNamespaceRoot :: forall m. DB m => CausalHashId -> m ()
+setNamespaceRoot :: CausalHashId -> Transaction ()
 setNamespaceRoot id =
   queryOneCol_ "SELECT EXISTS (SELECT 1 FROM namespace_root)" >>= \case
     False -> execute insert (Only id)
@@ -552,7 +541,7 @@ setNamespaceRoot id =
     insert = "INSERT INTO namespace_root VALUES (?)"
     update = "UPDATE namespace_root SET causal_id = ?"
 
-saveWatch :: DB m => WatchKind -> Reference.IdH -> ByteString -> m ()
+saveWatch :: WatchKind -> Reference.IdH -> ByteString -> Transaction ()
 saveWatch k r blob = execute sql (r :. Only blob) >> execute sql2 (r :. Only k)
   where
     sql = [here|
@@ -566,7 +555,12 @@ saveWatch k r blob = execute sql (r :. Only blob) >> execute sql2 (r :. Only k)
       ON CONFLICT DO NOTHING
     |]
 
-loadWatch :: (DB m, SqliteExceptionReason e) => WatchKind -> Reference.IdH -> (ByteString -> Either e a) -> m (Maybe a)
+loadWatch ::
+  SqliteExceptionReason e =>
+  WatchKind ->
+  Reference.IdH ->
+  (ByteString -> Either e a) ->
+  Transaction (Maybe a)
 loadWatch k r check = queryMaybeColCheck sql (Only k :. r) check where sql = [here|
     SELECT result FROM watch_result
     INNER JOIN watch
@@ -577,7 +571,7 @@ loadWatch k r check = queryMaybeColCheck sql (Only k :. r) check where sql = [he
       AND watch.component_index = ?
   |]
 
-loadWatchKindsByReference :: DB m => Reference.IdH -> m [WatchKind]
+loadWatchKindsByReference :: Reference.IdH -> Transaction [WatchKind]
 loadWatchKindsByReference r = queryListCol sql r where sql = [here|
     SELECT watch_kind_id FROM watch_result
     INNER JOIN watch
@@ -587,18 +581,18 @@ loadWatchKindsByReference r = queryListCol sql r where sql = [here|
       AND watch.component_index = ?
   |]
 
-loadWatchesByWatchKind :: DB m => WatchKind -> m [Reference.IdH]
+loadWatchesByWatchKind :: WatchKind -> Transaction [Reference.IdH]
 loadWatchesByWatchKind k = queryListRow sql (Only k) where sql = [here|
   SELECT hash_id, component_index FROM watch WHERE watch_kind_id = ?
 |]
 
-clearWatches :: DB m => m ()
+clearWatches :: Transaction ()
 clearWatches = do
   execute_ "DELETE FROM watch_result"
   execute_ "DELETE FROM watch"
 
 -- * Index-building
-addToTypeIndex :: DB m => Reference' TextId HashId -> Referent.Id -> m ()
+addToTypeIndex :: Reference' TextId HashId -> Referent.Id -> Transaction ()
 addToTypeIndex tp tm = execute sql (tp :. tm) where sql = [here|
   INSERT INTO find_type_index (
     type_reference_builtin,
@@ -611,7 +605,7 @@ addToTypeIndex tp tm = execute sql (tp :. tm) where sql = [here|
   ON CONFLICT DO NOTHING
 |]
 
-getReferentsByType :: DB m => Reference' TextId HashId -> m [Referent.Id]
+getReferentsByType :: Reference' TextId HashId -> Transaction [Referent.Id]
 getReferentsByType r = queryListRow sql r where sql = [here|
   SELECT
     term_referent_object_id,
@@ -623,7 +617,7 @@ getReferentsByType r = queryListRow sql r where sql = [here|
     AND type_reference_component_index IS ?
 |]
 
-getTypeReferenceForReferent :: DB m => Referent.Id -> m (Reference' TextId HashId)
+getTypeReferenceForReferent :: Referent.Id -> Transaction (Reference' TextId HashId)
 getTypeReferenceForReferent r =
   queryOneRow sql r
   where sql = [here|
@@ -638,7 +632,7 @@ getTypeReferenceForReferent r =
 |]
 
 -- todo: error if no results
-getTypeReferencesForComponent :: DB m => ObjectId -> m [(Reference' TextId HashId, Referent.Id)]
+getTypeReferencesForComponent :: ObjectId -> Transaction [(Reference' TextId HashId, Referent.Id)]
 getTypeReferencesForComponent oId =
   queryListRow sql (Only oId) <&> map fixupTypeIndexRow where sql = [here|
     SELECT
@@ -652,7 +646,7 @@ getTypeReferencesForComponent oId =
     WHERE term_referent_object_id = ?
   |]
 
-addToTypeMentionsIndex :: DB m => Reference' TextId HashId -> Referent.Id -> m ()
+addToTypeMentionsIndex :: Reference' TextId HashId -> Referent.Id -> Transaction ()
 addToTypeMentionsIndex tp tm = execute sql (tp :. tm) where sql = [here|
   INSERT INTO find_type_mentions_index (
     type_reference_builtin,
@@ -665,7 +659,7 @@ addToTypeMentionsIndex tp tm = execute sql (tp :. tm) where sql = [here|
   ON CONFLICT DO NOTHING
 |]
 
-getReferentsByTypeMention :: DB m => Reference' TextId HashId -> m [Referent.Id]
+getReferentsByTypeMention :: Reference' TextId HashId -> Transaction [Referent.Id]
 getReferentsByTypeMention r = queryListRow sql r where sql = [here|
   SELECT
     term_referent_object_id,
@@ -678,7 +672,7 @@ getReferentsByTypeMention r = queryListRow sql r where sql = [here|
 |]
 
 -- todo: error if no results
-getTypeMentionsReferencesForComponent :: DB m => ObjectId -> m [(Reference' TextId HashId, Referent.Id)]
+getTypeMentionsReferencesForComponent :: ObjectId -> Transaction [(Reference' TextId HashId, Referent.Id)]
 getTypeMentionsReferencesForComponent r =
   queryListRow sql (Only r) <&> map fixupTypeIndexRow where sql = [here|
     SELECT
@@ -698,7 +692,7 @@ fixupTypeIndexRow (rh :. ri) = (rh, ri)
 -- | Delete objects without hashes. An object typically *would* have a hash, but (for example) during a migration in which an object's hash
 -- may change, its corresponding hash_object row may be updated to point at a new version of that object. This procedure clears out all
 -- references to objects that do not have any corresponding hash_object rows.
-garbageCollectObjectsWithoutHashes :: DB m => m ()
+garbageCollectObjectsWithoutHashes :: Transaction ()
 garbageCollectObjectsWithoutHashes = do
   execute_
     [here|
@@ -737,7 +731,7 @@ garbageCollectObjectsWithoutHashes = do
     |]
 
 -- | Delete all
-garbageCollectWatchesWithoutObjects :: DB m => m ()
+garbageCollectWatchesWithoutObjects :: Transaction ()
 garbageCollectWatchesWithoutObjects = do
   execute_
     [here|
@@ -746,12 +740,7 @@ garbageCollectWatchesWithoutObjects = do
       (SELECT hash_object.hash_id FROM hash_object)
     |]
 
--- | Clean the database and recover disk space.
--- This is an expensive operation. Also note that it cannot be executed within a transaction.
-vacuum :: DB m => m ()
-vacuum = execute_ "VACUUM"
-
-addToDependentsIndex :: DB m => Reference.Reference -> Reference.Id -> m ()
+addToDependentsIndex :: Reference.Reference -> Reference.Id -> Transaction ()
 addToDependentsIndex dependency dependent = execute sql (dependency :. dependent)
   where sql = [here|
     INSERT INTO dependents_index (
@@ -765,7 +754,7 @@ addToDependentsIndex dependency dependent = execute sql (dependency :. dependent
   |]
 
 -- | Get non-self, user-defined dependents of a dependency.
-getDependentsForDependency :: DB m => Reference.Reference -> m [Reference.Id]
+getDependentsForDependency :: Reference.Reference -> Transaction [Reference.Id]
 getDependentsForDependency dependency =
   filter isNotSelfReference <$> queryListRow sql dependency
   where
@@ -784,7 +773,7 @@ getDependentsForDependency dependency =
         ReferenceBuiltin _ -> const True
         ReferenceDerived (C.Reference.Id oid0 _pos0) -> \(C.Reference.Id oid1 _pos1) -> oid0 /= oid1
 
-getDependentsForDependencyComponent :: DB m => ObjectId -> m [Reference.Id]
+getDependentsForDependencyComponent :: ObjectId -> Transaction [Reference.Id]
 getDependentsForDependencyComponent dependency =
   filter isNotSelfReference <$> queryListRow sql (Only dependency)
   where
@@ -801,7 +790,7 @@ getDependentsForDependencyComponent dependency =
       (C.Reference.Id oid1 _pos1) -> dependency /= oid1
 
 -- | Get non-self dependencies of a user-defined dependent.
-getDependenciesForDependent :: DB m => Reference.Id -> m [Reference.Reference]
+getDependenciesForDependent :: Reference.Id -> Transaction [Reference.Reference]
 getDependenciesForDependent dependent@(C.Reference.Id oid0 _) =
   filter isNotSelfReference <$> queryListRow sql dependent
   where
@@ -819,7 +808,7 @@ getDependenciesForDependent dependent@(C.Reference.Id oid0 _) =
       ReferenceDerived (C.Reference.Id oid1 _) -> oid0 /= oid1
 
 -- | Get non-self, user-defined dependencies of a user-defined dependent.
-getDependencyIdsForDependent :: DB m => Reference.Id -> m [Reference.Id]
+getDependencyIdsForDependent :: Reference.Id -> Transaction [Reference.Id]
 getDependencyIdsForDependent dependent@(C.Reference.Id oid0 _) =
   filter isNotSelfReference <$> queryListRow sql dependent
   where
@@ -836,7 +825,7 @@ getDependencyIdsForDependent dependent@(C.Reference.Id oid0 _) =
     isNotSelfReference (C.Reference.Id oid1 _) =
       oid0 /= oid1
 
-objectIdByBase32Prefix :: DB m => ObjectType -> Text -> m [ObjectId]
+objectIdByBase32Prefix :: ObjectType -> Text -> Transaction [ObjectId]
 objectIdByBase32Prefix objType prefix = queryListCol sql (objType, prefix <> "%") where sql = [here|
   SELECT object.id FROM object
   INNER JOIN hash_object ON hash_object.object_id = object.id
@@ -845,14 +834,14 @@ objectIdByBase32Prefix objType prefix = queryListCol sql (objType, prefix <> "%"
     AND hash.base32 LIKE ?
 |]
 
-causalHashIdByBase32Prefix :: DB m => Text -> m [CausalHashId]
+causalHashIdByBase32Prefix :: Text -> Transaction [CausalHashId]
 causalHashIdByBase32Prefix prefix = queryListCol sql (Only $ prefix <> "%") where sql = [here|
   SELECT self_hash_id FROM causal
   INNER JOIN hash ON id = self_hash_id
   WHERE base32 LIKE ?
 |]
 
-namespaceHashIdByBase32Prefix :: DB m => Text -> m [BranchHashId]
+namespaceHashIdByBase32Prefix :: Text -> Transaction [BranchHashId]
 namespaceHashIdByBase32Prefix prefix = queryListCol sql (Only $ prefix <> "%") where sql = [here|
   SELECT value_hash_id FROM causal
   INNER JOIN hash ON id = value_hash_id
@@ -862,7 +851,7 @@ namespaceHashIdByBase32Prefix prefix = queryListCol sql (Only $ prefix <> "%") w
 -- | Finds all causals that refer to a branch for which we don't have an object stored.
 -- Although there are plans to support this in the future, currently all such cases
 -- are the result of database inconsistencies and are unexpected.
-getCausalsWithoutBranchObjects :: DB m => m [CausalHashId]
+getCausalsWithoutBranchObjects :: Transaction [CausalHashId]
 getCausalsWithoutBranchObjects = queryListCol_ sql
   where sql = [here|
     SELECT self_hash_id from causal
@@ -873,7 +862,7 @@ getCausalsWithoutBranchObjects = queryListCol_ sql
 
 -- | Delete all hash objects of a given hash version.
 -- Leaves the corresponding `hash`es in the hash table alone.
-removeHashObjectsByHashingVersion :: DB m => HashVersion -> m ()
+removeHashObjectsByHashingVersion :: HashVersion -> Transaction ()
 removeHashObjectsByHashingVersion hashVersion =
   execute sql (Only hashVersion)
   where
@@ -883,12 +872,12 @@ removeHashObjectsByHashingVersion hashVersion =
       WHERE hash_version = ?
 |]
 
-before :: DB m => CausalHashId -> CausalHashId -> m Bool
+before :: CausalHashId -> CausalHashId -> Transaction Bool
 before chId1 chId2 = queryOneCol sql (chId2, chId1)
   where
     sql = fromString $ "SELECT EXISTS (" ++ ancestorSql ++ " WHERE ancestor.id = ?)"
 
--- the `Connection` arguments come second to fit the shape of Exception.bracket + uncurry curry
+-- | the `Connection` arguments come second to fit the shape of Exception.bracket + uncurry curry
 lca :: CausalHashId -> CausalHashId -> Connection -> Connection -> IO (Maybe CausalHashId)
 lca x y cx cy =
   withStatement cx sql (Only x) \nextX ->

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

@@ -11,7 +11,6 @@ module U.Codebase.Sqlite.Sync22 where
 
 import Control.Monad.Except (MonadError (throwError))
 import Control.Monad.RWS (MonadReader)
-import Control.Monad.Reader (ReaderT)
 import qualified Control.Monad.Reader as Reader
 import Control.Monad.Validate (ValidateT, runValidateT)
 import qualified Control.Monad.Validate as Validate
@@ -40,7 +39,7 @@ import qualified U.Codebase.WatchKind as WK
 import U.Util.Cache (Cache)
 import qualified U.Util.Cache as Cache
 import Unison.Prelude
-import Unison.Sqlite (Connection)
+import Unison.Sqlite (Connection, Transaction, runTransaction)
 
 data Entity
   = O ObjectId
@@ -413,12 +412,8 @@ trySync tCache hCache oCache cCache = \case
 
 runSrc,
   runDest ::
-    MonadReader Env m =>
-    ReaderT Connection m a ->
+    (MonadIO m, MonadReader Env m) =>
+    Transaction a ->
     m a
-runSrc ma = Reader.reader srcDB >>= flip runDB ma
-runDest ma = Reader.reader destDB >>= flip runDB ma
-
-runDB :: Connection -> ReaderT Connection m a -> m a
-runDB conn action =
-  Reader.runReaderT action conn
+runSrc ma = Reader.reader srcDB >>= flip runTransaction ma
+runDest ma = Reader.reader destDB >>= flip runTransaction ma

lib/unison-sqlite/src/Unison/Sqlite.hs

@@ -19,6 +19,7 @@ module Unison.Sqlite
     Transaction,
     runTransaction,
     savepoint,
+    idempotentIO,
 
     -- * Executing queries
     Sql (..),
@@ -75,6 +76,10 @@ module Unison.Sqlite
     JournalMode (..),
     trySetJournalMode,
 
+    -- * Vacuum
+    vacuum,
+    vacuumInto,
+
     -- ** Low-level
     withStatement,
 
@@ -109,6 +114,8 @@ import Unison.Sqlite.Connection
   ( Connection,
     ExpectedAtMostOneRowException (..),
     ExpectedExactlyOneRowException (..),
+    vacuum,
+    vacuumInto,
     withConnection,
     withStatement,
   )

lib/unison-sqlite/src/Unison/Sqlite/Connection.hs

@@ -48,6 +48,10 @@ module Unison.Sqlite.Connection
     queryOneRowCheck_,
     queryOneColCheck_,
 
+    -- * Vacuum (into)
+    vacuum,
+    vacuumInto,
+
     -- * Low-level operations
     withSavepoint,
     withSavepointIO,
@@ -415,6 +419,18 @@ queryOneColCheck_ ::
 queryOneColCheck_ conn s check =
   queryOneRowCheck_ conn s (coerce @(a -> Either e r) @(Sqlite.Only a -> Either e r) check)
 
+-- Vacuum
+
+-- | @VACUUM@
+vacuum :: Connection -> IO ()
+vacuum conn =
+  execute_ conn "VACUUM"
+
+-- | @VACUUM INTO@
+vacuumInto :: Connection -> Text -> IO ()
+vacuumInto conn file =
+  execute conn "VACUUM INTO ?" (Sqlite.Only file)
+
 -- Low-level
 
 -- | Perform an action within a named savepoint. The action is provided a rollback action.

lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs

@@ -3,6 +3,7 @@ module Unison.Sqlite.Transaction
     Transaction,
     runTransaction,
     savepoint,
+    idempotentIO,
 
     -- * Executing queries
 
@@ -103,6 +104,7 @@ runTransaction conn (Transaction f) = liftIO do
     ignoringExceptions action =
       action `catchAny` \_ -> pure ()
 
+-- | Perform an atomic sub-computation within a transaction; if it returns 'Left', it's rolled back.
 savepoint :: Transaction (Either a a) -> Transaction a
 savepoint (Transaction action) = do
   Transaction \conn -> do
@@ -117,6 +119,11 @@ savepoint (Transaction action) = do
           pure result
         Right result -> pure result
 
+-- | Perform IO inside a transaction, which should be idempotent, because it may be run more than once.
+idempotentIO :: IO a -> Transaction a
+idempotentIO action =
+  Transaction \_ -> action
+
 -- Without results, with parameters
 
 execute :: Sqlite.ToRow a => Sql -> a -> Transaction ()

parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateSchema1To2/DbHelpers.hs

@@ -35,11 +35,11 @@ import qualified Unison.Hashing.V2.TermEdit as Hashing.TermEdit
 import qualified Unison.Hashing.V2.TypeEdit as Hashing (TypeEdit)
 import qualified Unison.Hashing.V2.TypeEdit as Hashing.TypeEdit
 import Unison.Prelude
-import Unison.Sqlite (DB)
+import Unison.Sqlite (Transaction)
 import qualified Unison.Util.Map as Map
 import qualified Unison.Util.Set as Set
 
-dbBranchHash :: DB m => S.DbBranch -> m Hash
+dbBranchHash :: S.DbBranch -> Transaction Hash
 dbBranchHash (S.Branch.Full.Branch tms tps patches children) =
   fmap Hashing.Branch.hashBranch $
     Hashing.Branch.Raw
@@ -48,92 +48,93 @@ dbBranchHash (S.Branch.Full.Branch tms tps patches children) =
       <*> doPatches patches
       <*> doChildren children
   where
-    doTerms :: DB m => Map Db.TextId (Map S.Referent S.DbMetadataSet) -> m (Map NameSegment (Map Hashing.Referent Hashing.Branch.MdValues))
+    doTerms ::
+      Map Db.TextId (Map S.Referent S.DbMetadataSet) ->
+      Transaction (Map NameSegment (Map Hashing.Referent Hashing.Branch.MdValues))
     doTerms =
       Map.bitraverse
         s2hNameSegment
         (Map.bitraverse s2hReferent s2hMetadataSet)
 
     doTypes ::
-      DB m =>
       Map Db.TextId (Map S.Reference S.DbMetadataSet) ->
-      m (Map NameSegment (Map Hashing.Reference Hashing.Branch.MdValues))
+      Transaction (Map NameSegment (Map Hashing.Reference Hashing.Branch.MdValues))
     doTypes =
       Map.bitraverse
         s2hNameSegment
         (Map.bitraverse s2hReference s2hMetadataSet)
 
-    doPatches :: DB m => Map Db.TextId Db.PatchObjectId -> m (Map NameSegment Hash)
+    doPatches :: Map Db.TextId Db.PatchObjectId -> Transaction (Map NameSegment Hash)
     doPatches =
       Map.bitraverse s2hNameSegment (objectIdToPrimaryHash . Db.unPatchObjectId)
 
-    doChildren :: DB m => Map Db.TextId (Db.BranchObjectId, Db.CausalHashId) -> m (Map NameSegment Hash)
+    doChildren :: Map Db.TextId (Db.BranchObjectId, Db.CausalHashId) -> Transaction (Map NameSegment Hash)
     doChildren =
       Map.bitraverse s2hNameSegment \(_boId, chId) -> causalHashIdToHash chId
 
-dbPatchHash :: forall m. DB m => S.Patch -> m Hash
+dbPatchHash :: S.Patch -> Transaction Hash
 dbPatchHash S.Patch {S.termEdits, S.typeEdits} =
   fmap Hashing.Patch.hashPatch $
     Hashing.Patch
       <$> doTermEdits termEdits
       <*> doTypeEdits typeEdits
   where
-    doTermEdits :: Map S.ReferentH (Set S.TermEdit) -> m (Map Hashing.Referent (Set Hashing.TermEdit))
+    doTermEdits :: Map S.ReferentH (Set S.TermEdit) -> Transaction (Map Hashing.Referent (Set Hashing.TermEdit))
     doTermEdits =
       Map.bitraverse s2hReferentH (Set.traverse s2hTermEdit)
 
-    doTypeEdits :: Map S.ReferenceH (Set S.TypeEdit) -> m (Map Hashing.Reference (Set Hashing.TypeEdit))
+    doTypeEdits :: Map S.ReferenceH (Set S.TypeEdit) -> Transaction (Map Hashing.Reference (Set Hashing.TypeEdit))
     doTypeEdits =
       Map.bitraverse s2hReferenceH (Set.traverse s2hTypeEdit)
 
-s2hMetadataSet :: DB m => DbMetadataSet -> m Hashing.Branch.MdValues
+s2hMetadataSet :: DbMetadataSet -> Transaction Hashing.Branch.MdValues
 s2hMetadataSet = \case
   S.MetadataSet.Inline rs -> Hashing.Branch.MdValues <$> Set.traverse s2hReference rs
 
-s2hNameSegment :: DB m => Db.TextId -> m NameSegment
+s2hNameSegment :: Db.TextId -> Transaction NameSegment
 s2hNameSegment =
   fmap NameSegment . Q.expectText
 
-s2hReferent :: DB m => S.Referent -> m Hashing.Referent
+s2hReferent :: S.Referent -> Transaction Hashing.Referent
 s2hReferent = \case
   S.Referent.Ref r -> Hashing.Referent.Ref <$> s2hReference r
   S.Referent.Con r cid -> Hashing.Referent.Con <$> s2hReference r <*> pure (fromIntegral cid)
 
-s2hReferentH :: DB m => S.ReferentH -> m Hashing.Referent
+s2hReferentH :: S.ReferentH -> Transaction Hashing.Referent
 s2hReferentH = \case
   S.Referent.Ref r -> Hashing.Referent.Ref <$> s2hReferenceH r
   S.Referent.Con r cid -> Hashing.Referent.Con <$> s2hReferenceH r <*> pure (fromIntegral cid)
 
-s2hReference :: DB m => S.Reference -> m Hashing.Reference
+s2hReference :: S.Reference -> Transaction Hashing.Reference
 s2hReference = \case
   S.ReferenceBuiltin t -> Hashing.Reference.Builtin <$> Q.expectText t
   S.Reference.Derived h i -> Hashing.Reference.Derived <$> objectIdToPrimaryHash h <*> pure i
 
-s2hReferenceH :: DB m => S.ReferenceH -> m Hashing.Reference
+s2hReferenceH :: S.ReferenceH -> Transaction Hashing.Reference
 s2hReferenceH = \case
   S.ReferenceBuiltin t -> Hashing.Reference.Builtin <$> Q.expectText t
   S.Reference.Derived h i -> Hashing.Reference.Derived <$> expectHash h <*> pure i
 
-s2hTermEdit :: DB m => S.TermEdit -> m Hashing.TermEdit
+s2hTermEdit :: S.TermEdit -> Transaction Hashing.TermEdit
 s2hTermEdit = \case
   S.TermEdit.Replace r _typing -> Hashing.TermEdit.Replace <$> s2hReferent r
   S.TermEdit.Deprecate -> pure Hashing.TermEdit.Deprecate
 
-s2hTypeEdit :: DB m => S.TypeEdit -> m Hashing.TypeEdit
+s2hTypeEdit :: S.TypeEdit -> Transaction Hashing.TypeEdit
 s2hTypeEdit = \case
   S.TypeEdit.Replace r -> Hashing.TypeEdit.Replace <$> s2hReference r
   S.TypeEdit.Deprecate -> pure Hashing.TypeEdit.Deprecate
 
 -- Mitchell: Do these variants of Q.* queries belong somewhere else? Or in Q perhaps?
 
-causalHashIdToHash :: DB m => Db.CausalHashId -> m Hash
+causalHashIdToHash :: Db.CausalHashId -> Transaction Hash
 causalHashIdToHash =
   fmap Cv.hash2to1 . Q.expectHash . Db.unCausalHashId
 
-objectIdToPrimaryHash :: DB m => Db.ObjectId -> m Hash
+objectIdToPrimaryHash :: Db.ObjectId -> Transaction Hash
 objectIdToPrimaryHash =
   fmap Cv.hash2to1 . Q.expectPrimaryHashByObjectId
 
-expectHash :: DB m => Db.HashId -> m Hash
+expectHash :: Db.HashId -> Transaction Hash
 expectHash =
   fmap Cv.hash2to1 . Q.expectHash