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

This commit is contained in:
Joey Hess 2015-10-09 13:35:28 -04:00
parent 4c6095b6f5
commit 865dd11dbf
Failed to extract signature
2 changed files with 16 additions and 3 deletions

View file

@ -13,6 +13,7 @@ module Annex (
new, new,
run, run,
eval, eval,
makeRunner,
getState, getState,
changeState, changeState,
withState, withState,
@ -203,6 +204,13 @@ eval s a = do
mvar <- newMVar s mvar <- newMVar s
runReaderT (runAnnex a) mvar 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 :: (AnnexState -> v) -> Annex v
getState selector = do getState selector = do
mvar <- ask mvar <- ask

View file

@ -361,10 +361,15 @@ dropKey r key
| otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key | otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key
lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r
lockKey r key a lockKey r key callback
| not $ Git.repoIsUrl (repo r) = | not $ Git.repoIsUrl (repo r) =
guardUsable (repo r) cantlock $ guardUsable (repo r) cantlock $ do
onLocal r $ Annex.Content.lockContentShared key a inorigrepo <- Annex.makeRunner
-- Lock content from perspective of remote,
-- and then run the callback in the original
-- annex monad, not the remote's.
onLocal r $ Annex.Content.lockContentShared key $
liftIO . inorigrepo . callback
| Git.repoIsHttp (repo r) = cantlock | Git.repoIsHttp (repo r) = cantlock
| otherwise = error "TODO" | otherwise = error "TODO"
where where