aboutsummaryrefslogtreecommitdiff
path: root/Database
diff options
context:
space:
mode:
Diffstat (limited to 'Database')
-rw-r--r--Database/Keys.hs11
-rw-r--r--Database/Keys/Handle.hs12
2 files changed, 21 insertions, 2 deletions
diff --git a/Database/Keys.hs b/Database/Keys.hs
index ed3878161..778540137 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -9,6 +9,7 @@
module Database.Keys (
DbHandle,
+ closeDb,
addAssociatedFile,
getAssociatedFiles,
getAssociatedKey,
@@ -137,6 +138,16 @@ openDb createdb _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKe
False -> return DbUnavailable
True -> throwM e
+{- Closes the database if it was open. Any writes will be flushed to it.
+ -
+ - This does not normally need to be called; the database will auto-close
+ - when the handle is garbage collected. However, this can be used to
+ - force a re-read of the database, in case another process has written
+ - data to it.
+ -}
+closeDb :: Annex ()
+closeDb = liftIO . closeDbHandle =<< getDbHandle
+
addAssociatedFile :: Key -> TopFilePath -> Annex ()
addAssociatedFile k f = runWriterIO $ SQL.addAssociatedFile (toIKey k) f
diff --git a/Database/Keys/Handle.hs b/Database/Keys/Handle.hs
index 51de58fa8..1ef16d031 100644
--- a/Database/Keys/Handle.hs
+++ b/Database/Keys/Handle.hs
@@ -11,6 +11,7 @@ module Database.Keys.Handle (
DbState(..),
withDbState,
flushDbQueue,
+ closeDbHandle,
) where
import qualified Database.Queue as H
@@ -38,8 +39,7 @@ newDbHandle = DbHandle <$> newMVar DbClosed
withDbState
:: (MonadIO m, MonadCatch m)
=> DbHandle
- -> (DbState
- -> m (v, DbState))
+ -> (DbState -> m (v, DbState))
-> m v
withDbState (DbHandle mvar) a = do
st <- liftIO $ takeMVar mvar
@@ -55,3 +55,11 @@ flushDbQueue (DbHandle mvar) = go =<< readMVar mvar
where
go (DbOpen qh) = H.flushDbQueue qh
go _ = return ()
+
+closeDbHandle :: DbHandle -> IO ()
+closeDbHandle h = withDbState h go
+ where
+ go (DbOpen qh) = do
+ H.closeDbQueue qh
+ return ((), DbClosed)
+ go st = return ((), st)