diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-01-02 14:54:23 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-01-03 00:11:00 -0400 |
| commit | fc80b8d96bf287a0b83c1402e3a7c5ebfc7bc4a4 (patch) | |
| tree | 344c45f3bf1cd263e80bbb456700574b95ba90fd | |
| parent | 5cd44282a92dd6fa7eacc62858c8b8e553590195 (diff) | |
factor observe_
| -rw-r--r-- | Remote/Git.hs | 15 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 4 | ||||
| -rw-r--r-- | Utility/Monad.hs | 4 |
3 files changed, 10 insertions, 13 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index da81241eb..2e32ca239 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -115,13 +115,11 @@ tryGitConfigRead r pOpen ReadFromPipe "git" ["config", "--null", "--list", "--file", tmpfile] $ Git.Config.hRead r - store a = do - r' <- a + store = observe $ \r' -> do g <- gitRepo let l = Git.remotes g let g' = g { Git.remotes = exchange l r' } Annex.changeState $ \s -> s { Annex.repo = g' } - return r' exchange [] _ = [] exchange (old:ls) new = @@ -184,9 +182,7 @@ onLocal r a = do -- No need to update the branch; its data is not used -- for anything onLocal is used to do. Annex.BranchState.disableUpdate - ret <- a - liftIO Git.Command.reap - return ret + observe_ (liftIO Git.Command.reap) a keyUrls :: Git.Repo -> Key -> [String] keyUrls r key = map tourl (annexLocations key) @@ -221,10 +217,9 @@ copyToRemote r key -- run copy from perspective of remote liftIO $ onLocal r $ do ensureInitialized - ok <- Annex.Content.getViaTmp key $ - rsyncOrCopyFile params keysrc - Annex.Content.saveState - return ok + observe_ Annex.Content.saveState $ + Annex.Content.getViaTmp key $ + rsyncOrCopyFile params keysrc | Git.repoIsSsh r = do keysrc <- inRepo $ gitAnnexLocation key rsyncHelper =<< rsyncParamsRemote r False key keysrc diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 2fe302ba5..1461b96cd 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -172,9 +172,7 @@ withRsyncScratchDir a = do let tmp = t </> "rsynctmp" </> show pid nuke tmp liftIO $ createDirectoryIfMissing True tmp - res <- a tmp - nuke tmp - return res + observe_ (nuke tmp) (a tmp) where nuke d = liftIO $ doesDirectoryExist d >>? removeDirectoryRecursive d diff --git a/Utility/Monad.hs b/Utility/Monad.hs index 9e2a16e8c..7f9c7b1bc 100644 --- a/Utility/Monad.hs +++ b/Utility/Monad.hs @@ -36,3 +36,7 @@ observe observer a = do r <- a _ <- observer 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) |