optimise read and write for Keys database (untested)

Writes are optimised by queueing up multiple writes when possible.
The queue is flushed after the Annex monad action finishes. That makes it
happen on program termination, and also whenever a nested Annex monad action
finishes.

Reads are optimised by checking once (per AnnexState) if the database
exists. If the database doesn't exist yet, all reads return mempty.

Reads also cause queued writes to be flushed, so reads will always be
consistent with writes (as long as they're made inside the same Annex monad).
A future optimisation path would be to determine when that's not necessary,
which is probably most of the time, and avoid flushing unncessarily.

Design notes for this commit:

- separate reads from writes
- reuse a handle which is left open until program
  exit or until the MVar goes out of scope (and autoclosed then)
- writes are queued
  - queue is flushed periodically
  - immediate queue flush before any read
  - auto-flush queue when database handle is garbage collected
  - flush queue on exit from Annex monad
    (Note that this may happen repeatedly for a single database connection;
    or a connection may be reused for multiple Annex monad actions,
    possibly even concurrent ones.)
- if database does not exist (or is empty) the handle
  is not opened by reads; reads instead return empty results
- writes open the handle if it was not open previously
This commit is contained in:
Joey Hess 2015-12-23 18:34:51 -04:00
parent 959b060e26
commit 4224fae71f
Failed to extract signature
10 changed files with 213 additions and 91 deletions

View file

@ -60,6 +60,7 @@ import Types.NumCopies
import Types.LockCache
import Types.DesktopNotify
import Types.CleanupActions
import qualified Database.Keys.Handle as Keys
#ifdef WITH_QUVI
import Utility.Quvi (QuviVersion)
#endif
@ -134,6 +135,7 @@ data AnnexState = AnnexState
, desktopnotify :: DesktopNotify
, workers :: [Either AnnexState (Async AnnexState)]
, concurrentjobs :: Maybe Int
, keysdbhandle :: Maybe Keys.DbHandle
}
newState :: GitConfig -> Git.Repo -> AnnexState
@ -179,6 +181,7 @@ newState c r = AnnexState
, desktopnotify = mempty
, workers = []
, concurrentjobs = Nothing
, keysdbhandle = Nothing
}
{- Makes an Annex state object for the specified git repo.
@ -193,25 +196,26 @@ new r = do
{- Performs an action in the Annex monad from a starting state,
- returning a new state. -}
run :: AnnexState -> Annex a -> IO (a, AnnexState)
run s a = do
mvar <- newMVar s
run s a = flip run' a =<< newMVar s
run' :: MVar AnnexState -> Annex a -> IO (a, AnnexState)
run' mvar a = do
r <- runReaderT (runAnnex a) mvar
s' <- takeMVar mvar
maybe noop Keys.flushDbQueue (keysdbhandle s')
return (r, s')
{- Performs an action in the Annex monad from a starting state,
- and throws away the new state. -}
eval :: AnnexState -> Annex a -> IO a
eval s a = do
mvar <- newMVar s
runReaderT (runAnnex a) mvar
eval s a = fst <$> run s a
{- Makes a runner action, that allows diving into IO and from inside
- the IO action, running an Annex action. -}
makeRunner :: Annex (Annex a -> IO a)
makeRunner = do
mvar <- ask
return $ \a -> runReaderT (runAnnex a) mvar
return $ \a -> fst <$> run' mvar a
getState :: (AnnexState -> v) -> Annex v
getState selector = do