fix lockKey to run callback in original Annex monad, not local remote's

1 files changed, 8 insertions, 0 deletions

diff --git a/Annex.hs b/Annex.hs
index 78a6bf369..d6834e24a 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -13,6 +13,7 @@ module Annex (
 	new,
 	run,
 	eval,
+	makeRunner,
 	getState,
 	changeState,
 	withState,
@@ -203,6 +204,13 @@ eval s a = do
 	mvar <- newMVar s
 	runReaderT (runAnnex a) mvar
 
+{- 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
+
 getState :: (AnnexState -> v) -> Annex v
 getState selector = do
 	mvar <- ask