slightly more efficient checking of versionUsesKeysDatabase
It's a mvar lookup either way, but I think this way will be slightly more efficient. And it reduces the number of places where it's checked to 1.
This commit is contained in:
parent
b0c805b3c2
commit
e34046de38
2 changed files with 13 additions and 10 deletions
|
@ -54,12 +54,9 @@ import Database.Esqueleto hiding (Key)
|
||||||
- Any queued writes will be flushed before the read.
|
- Any queued writes will be flushed before the read.
|
||||||
-}
|
-}
|
||||||
runReader :: Monoid v => (SQL.ReadHandle -> Annex v) -> Annex v
|
runReader :: Monoid v => (SQL.ReadHandle -> Annex v) -> Annex v
|
||||||
runReader a = ifM versionUsesKeysDatabase
|
runReader a = do
|
||||||
( do
|
h <- getDbHandle
|
||||||
h <- getDbHandle
|
withDbState h go
|
||||||
withDbState h go
|
|
||||||
, return mempty
|
|
||||||
)
|
|
||||||
where
|
where
|
||||||
go DbUnavailable = return (mempty, DbUnavailable)
|
go DbUnavailable = return (mempty, DbUnavailable)
|
||||||
go st@(DbOpen qh) = do
|
go st@(DbOpen qh) = do
|
||||||
|
@ -81,7 +78,7 @@ runReaderIO a = runReader (liftIO . a)
|
||||||
-
|
-
|
||||||
- The database is created if it doesn't exist yet. -}
|
- The database is created if it doesn't exist yet. -}
|
||||||
runWriter :: (SQL.WriteHandle -> Annex ()) -> Annex ()
|
runWriter :: (SQL.WriteHandle -> Annex ()) -> Annex ()
|
||||||
runWriter a = whenM versionUsesKeysDatabase $ do
|
runWriter a = do
|
||||||
h <- getDbHandle
|
h <- getDbHandle
|
||||||
withDbState h go
|
withDbState h go
|
||||||
where
|
where
|
||||||
|
@ -105,7 +102,10 @@ getDbHandle = go =<< Annex.getState Annex.keysdbhandle
|
||||||
where
|
where
|
||||||
go (Just h) = pure h
|
go (Just h) = pure h
|
||||||
go Nothing = do
|
go Nothing = do
|
||||||
h <- liftIO newDbHandle
|
h <- ifM versionUsesKeysDatabase
|
||||||
|
( liftIO newDbHandle
|
||||||
|
, liftIO unavailableDbHandle
|
||||||
|
)
|
||||||
Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }
|
Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }
|
||||||
return h
|
return h
|
||||||
|
|
||||||
|
@ -150,8 +150,7 @@ openDb createdb _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKe
|
||||||
- data to it.
|
- data to it.
|
||||||
-}
|
-}
|
||||||
closeDb :: Annex ()
|
closeDb :: Annex ()
|
||||||
closeDb = whenM versionUsesKeysDatabase $
|
closeDb = liftIO . closeDbHandle =<< getDbHandle
|
||||||
liftIO . closeDbHandle =<< getDbHandle
|
|
||||||
|
|
||||||
addAssociatedFile :: Key -> TopFilePath -> Annex ()
|
addAssociatedFile :: Key -> TopFilePath -> Annex ()
|
||||||
addAssociatedFile k f = runWriterIO $ SQL.addAssociatedFile (toIKey k) f
|
addAssociatedFile k f = runWriterIO $ SQL.addAssociatedFile (toIKey k) f
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
module Database.Keys.Handle (
|
module Database.Keys.Handle (
|
||||||
DbHandle,
|
DbHandle,
|
||||||
newDbHandle,
|
newDbHandle,
|
||||||
|
unavailableDbHandle,
|
||||||
DbState(..),
|
DbState(..),
|
||||||
withDbState,
|
withDbState,
|
||||||
flushDbQueue,
|
flushDbQueue,
|
||||||
|
@ -33,6 +34,9 @@ data DbState = DbClosed | DbOpen H.DbQueue | DbUnavailable
|
||||||
newDbHandle :: IO DbHandle
|
newDbHandle :: IO DbHandle
|
||||||
newDbHandle = DbHandle <$> newMVar DbClosed
|
newDbHandle = DbHandle <$> newMVar DbClosed
|
||||||
|
|
||||||
|
unavailableDbHandle :: IO DbHandle
|
||||||
|
unavailableDbHandle = DbHandle <$> newMVar DbUnavailable
|
||||||
|
|
||||||
-- Runs an action on the state of the handle, which can change its state.
|
-- Runs an action on the state of the handle, which can change its state.
|
||||||
-- The MVar is empty while the action runs, which blocks other users
|
-- The MVar is empty while the action runs, which blocks other users
|
||||||
-- of the handle from running.
|
-- of the handle from running.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue