diff options
Diffstat (limited to 'Annex.hs')
| -rw-r--r-- | Annex.hs | 16 |
1 files changed, 10 insertions, 6 deletions
@@ -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 |