diff options
Diffstat (limited to 'Database')
-rw-r--r-- | Database/Keys.hs | 11 | ||||
-rw-r--r-- | Database/Keys/Handle.hs | 12 |
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) |