mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add debugging around commits to sqlite dbs

Browse source
This commit is contained in:
Joey Hess 2022-06-06 12:36:55 -04:00
parent a57ad1e226
commit 5da1a78508
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 9 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
Database/Handle.hs
View file

@ -5,7 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE TypeFamilies, FlexibleContexts #-} {-# LANGUAGE TypeFamilies, FlexibleContexts, OverloadedStrings #-}
module Database.Handle ( module Database.Handle (
DbHandle, DbHandle,
@ -19,6 +19,7 @@ module Database.Handle (
import Utility.Exception import Utility.Exception
import Utility.FileSystemEncoding import Utility.FileSystemEncoding
import Utility.Debug
import Utility.DebugLocks import Utility.DebugLocks
import Database.Persist.Sqlite import Database.Persist.Sqlite
@ -100,10 +101,16 @@ commitDb h wa = robustly Nothing 100 (commitDb' h wa)
commitDb' :: DbHandle -> SqlPersistM () -> IO (Either SomeException ()) commitDb' :: DbHandle -> SqlPersistM () -> IO (Either SomeException ())
commitDb' (DbHandle _ jobs) a = do commitDb' (DbHandle _ jobs) a = do
debug "Database.Handle" "commitDb start"
res <- newEmptyMVar res <- newEmptyMVar
putMVar jobs $ ChangeJob $ putMVar jobs $ ChangeJob $
debugLocks $ liftIO . putMVar res =<< tryNonAsync a debugLocks $ liftIO . putMVar res =<< tryNonAsync a
debugLocks $ takeMVar res r <- debugLocks $ takeMVar res
case r of
Right () -> debug "Database.Handle" "commitDb done"
Left e -> debug "Database.Handle" ("commitDb failed: " ++ show e)
return r
data Job data Job
= QueryJob (SqlPersistM ()) = QueryJob (SqlPersistM ())