factor observe_

This commit is contained in:
Joey Hess 2012-01-02 14:54:23 -04:00
parent 5cd44282a9
commit fc80b8d96b
3 changed files with 10 additions and 13 deletions

View file

@ -115,13 +115,11 @@ tryGitConfigRead r
pOpen ReadFromPipe "git" ["config", "--null", "--list", "--file", tmpfile] $ pOpen ReadFromPipe "git" ["config", "--null", "--list", "--file", tmpfile] $
Git.Config.hRead r Git.Config.hRead r
store a = do store = observe $ \r' -> do
r' <- a
g <- gitRepo g <- gitRepo
let l = Git.remotes g let l = Git.remotes g
let g' = g { Git.remotes = exchange l r' } let g' = g { Git.remotes = exchange l r' }
Annex.changeState $ \s -> s { Annex.repo = g' } Annex.changeState $ \s -> s { Annex.repo = g' }
return r'
exchange [] _ = [] exchange [] _ = []
exchange (old:ls) new = exchange (old:ls) new =
@ -184,9 +182,7 @@ onLocal r a = do
-- No need to update the branch; its data is not used -- No need to update the branch; its data is not used
-- for anything onLocal is used to do. -- for anything onLocal is used to do.
Annex.BranchState.disableUpdate Annex.BranchState.disableUpdate
ret <- a observe_ (liftIO Git.Command.reap) a
liftIO Git.Command.reap
return ret
keyUrls :: Git.Repo -> Key -> [String] keyUrls :: Git.Repo -> Key -> [String]
keyUrls r key = map tourl (annexLocations key) keyUrls r key = map tourl (annexLocations key)
@ -221,10 +217,9 @@ copyToRemote r key
-- run copy from perspective of remote -- run copy from perspective of remote
liftIO $ onLocal r $ do liftIO $ onLocal r $ do
ensureInitialized ensureInitialized
ok <- Annex.Content.getViaTmp key $ observe_ Annex.Content.saveState $
rsyncOrCopyFile params keysrc Annex.Content.getViaTmp key $
Annex.Content.saveState rsyncOrCopyFile params keysrc
return ok
| Git.repoIsSsh r = do | Git.repoIsSsh r = do
keysrc <- inRepo $ gitAnnexLocation key keysrc <- inRepo $ gitAnnexLocation key
rsyncHelper =<< rsyncParamsRemote r False key keysrc rsyncHelper =<< rsyncParamsRemote r False key keysrc

View file

@ -172,9 +172,7 @@ withRsyncScratchDir a = do
let tmp = t </> "rsynctmp" </> show pid let tmp = t </> "rsynctmp" </> show pid
nuke tmp nuke tmp
liftIO $ createDirectoryIfMissing True tmp liftIO $ createDirectoryIfMissing True tmp
res <- a tmp observe_ (nuke tmp) (a tmp)
nuke tmp
return res
where where
nuke d = liftIO $ nuke d = liftIO $
doesDirectoryExist d >>? removeDirectoryRecursive d doesDirectoryExist d >>? removeDirectoryRecursive d

View file

@ -36,3 +36,7 @@ observe observer a = do
r <- a r <- a
_ <- observer r _ <- observer r
return r return r
{- Like observe, but the observer is not passed the value. -}
observe_ :: (Monad m) => m b -> m a -> m a
observe_ observer = observe (const observer)