Sped up sqlite inserts 2x when built with persistent 2.14.5.0

https://github.com/yesodweb/persistent/issues/1457

Sponsored-by: Dartmouth College's DANDI project

Database/ContentIdentifier.hs

@@ -36,6 +36,7 @@ module Database.ContentIdentifier (
 import Database.Types
 import qualified Database.Queue as H
 import Database.Init
+import Database.Utility
 import Annex.Locations
 import Annex.Common hiding (delete)
 import qualified Annex.Branch
@@ -109,7 +110,7 @@ flushDbQueue (ContentIdentifierHandle h) = H.flushDbQueue h
 -- Be sure to also update the git-annex branch when using this.
 recordContentIdentifier :: ContentIdentifierHandle -> RemoteStateHandle -> ContentIdentifier -> Key -> IO ()
 recordContentIdentifier h (RemoteStateHandle u) cid k = queueDb h $ do
-	void $ insertUnique $ ContentIdentifiers u cid k
+	void $ insertUniqueFast $ ContentIdentifiers u cid k
 
 getContentIdentifiers :: ContentIdentifierHandle -> RemoteStateHandle -> Key -> IO [ContentIdentifier]
 getContentIdentifiers (ContentIdentifierHandle h) (RemoteStateHandle u) k = 
@@ -132,7 +133,7 @@ getContentIdentifierKeys (ContentIdentifierHandle h) (RemoteStateHandle u) cid =
 recordAnnexBranchTree :: ContentIdentifierHandle -> Sha -> IO ()
 recordAnnexBranchTree h s = queueDb h $ do
         deleteWhere ([] :: [Filter AnnexBranch])
-        void $ insertUnique $ AnnexBranch $ toSSha s
+        void $ insertUniqueFast $ AnnexBranch $ toSSha s
 
 getAnnexBranchTree :: ContentIdentifierHandle -> IO Sha
 getAnnexBranchTree (ContentIdentifierHandle h) = H.queryDbQueue h $ do

Database/Export.hs

@@ -49,6 +49,7 @@ module Database.Export (
 import Database.Types
 import qualified Database.Queue as H
 import Database.Init
+import Database.Utility
 import Annex.Locations
 import Annex.Common hiding (delete)
 import Types.Export
@@ -124,7 +125,7 @@ flushDbQueue (ExportHandle h _) = H.flushDbQueue h
 recordExportTreeCurrent :: ExportHandle -> Sha -> IO ()
 recordExportTreeCurrent h s = queueDb h $ do
 	deleteWhere ([] :: [Filter ExportTreeCurrent])
-	void $ insertUnique $ ExportTreeCurrent $ toSSha s
+	void $ insertUniqueFast $ ExportTreeCurrent $ toSSha s
 
 getExportTreeCurrent :: ExportHandle -> IO (Maybe Sha)
 getExportTreeCurrent (ExportHandle h _) = H.queryDbQueue h $ do
@@ -136,7 +137,7 @@ getExportTreeCurrent (ExportHandle h _) = H.queryDbQueue h $ do
 
 addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
 addExportedLocation h k el = queueDb h $ do
-	void $ insertUnique $ Exported k ef
+	void $ insertUniqueFast $ Exported k ef
 	let edirs = map
 		(\ed -> ExportedDirectory (SFilePath (fromExportDirectory ed)) ef)
 		(exportDirectories el)
@@ -186,7 +187,7 @@ getExportTreeKey (ExportHandle h _) el = H.queryDbQueue h $ do
 
 addExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
 addExportTree h k loc = queueDb h $
-	void $ insertUnique $ ExportTree k ef
+	void $ insertUniqueFast $ ExportTree k ef
   where
 	ef = SFilePath (fromExportLocation loc)
 

Database/Fsck.hs

@@ -29,6 +29,7 @@ module Database.Fsck (
 
 import Database.Types
 import qualified Database.Queue as H
+import Database.Utility
 import Database.Init
 import Annex.Locations
 import Utility.Exception
@@ -88,7 +89,7 @@ closeDb (FsckHandle h u) = do
 
 addDb :: FsckHandle -> Key -> IO ()
 addDb (FsckHandle h _) k = H.queueDb h checkcommit $
-	void $ insertUnique $ Fscked k
+	void $ insertUniqueFast $ Fscked k
   where
 	-- Commit queue after 1000 changes or 5 minutes, whichever comes first.
 	-- The time based commit allows for an incremental fsck to be

Database/Handle.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE TypeFamilies, FlexibleContexts, OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts, OverloadedStrings, CPP #-}
 
 module Database.Handle (
 	DbHandle,
@@ -329,4 +329,3 @@ isDatabaseModified (DatabaseInodeCache a1 b1) (DatabaseInodeCache a2 b2) =
 
 takeMVarSafe :: MVar a -> IO (Either BlockedIndefinitelyOnMVar a)
 takeMVarSafe = try . takeMVar
-

Database/Keys/SQL.hs

@@ -21,6 +21,7 @@ module Database.Keys.SQL where
 
 import Database.Types
 import Database.Handle
+import Database.Utility
 import qualified Database.Queue as H
 import Utility.InodeCache
 import Git.FilePath
@@ -121,7 +122,7 @@ removeAssociatedFile k f = queueDb $
 
 addInodeCaches :: Key -> [InodeCache] -> WriteHandle -> IO ()
 addInodeCaches k is = queueDb $
-	forM_ is $ \i -> insertUnique $ Content k i 
+	forM_ is $ \i -> insertUniqueFast $ Content k i 
 		(inodeCacheToFileSize i)
 		(inodeCacheToEpochTime i)
 

Database/Utility.hs

@@ -0,0 +1,27 @@
+{- Persistent sqlite database utilities.
+ -
+ - Copyright 2023 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE TypeFamilies, CPP #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module Database.Utility (
+	insertUniqueFast,
+) where
+
+import Control.Monad
+import Database.Persist.Class
+
+{- insertUnique_ is 2x as fast as insertUnique, so use when available.
+ -
+ - It would be difficult to write the type signature here, since older
+ - versions of persistent have different constraints on insertUnique.
+ -}
+#if MIN_VERSION_persistent(2,14,5)
+insertUniqueFast x = void (insertUnique_ x)
+#else
+insertUniqueFast x = void (insertUnique x)
+#endif