refactor

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 46b571a2ef87ad5197b6dfb2353248ecdf996701..d410db02fd2807c054c1338c1ae835e4bfac9c2f 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -641,19 +641,8 @@ rsyncOrCopyFile rsyncparams src dest p =
   where
        sameDeviceIds a b = (==) <$> getDeviceId a <*> getDeviceId b
        getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
-       docopy = liftIO $ bracket
-               (forkIO $ watchfilesize zeroBytesProcessed)
-               (void . tryIO . killThread)
-               (const $ copyFileExternal CopyTimeStamps src dest)
-       watchfilesize oldsz = do
-               threadDelay 500000 -- 0.5 seconds
-               v <- catchMaybeIO $ toBytesProcessed <$> getFileSize dest
-               case v of
-                       Just sz
-                               | sz /= oldsz -> do
-                                       p sz
-                                       watchfilesize sz
-                       _ -> watchfilesize oldsz
+       docopy = liftIO $ watchFileSize dest p $
+               copyFileExternal CopyTimeStamps src dest
 #endif
        dorsync = Ssh.rsyncHelper (Just p) $
                rsyncparams ++ [File src, File dest]

diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index 60dcf7c74cca4afaa3fa87cf39b74982d18b87dc..da83fd8cd15f23a3b8f0c8f1817b282e656a453b 100644 (file)
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -18,7 +18,9 @@ import Foreign.Storable (Storable(sizeOf))
 import System.Posix.Types
 import Data.Int
 import Data.Bits.Utils
+import Control.Concurrent
 import Control.Concurrent.Async
+import Control.Monad.IO.Class (MonadIO)
 
 {- An action that can be run repeatedly, updating it on the bytes processed.
  -
@@ -149,6 +151,23 @@ defaultChunkSize = 32 * k - chunkOverhead
        k = 1024
        chunkOverhead = 2 * sizeOf (1 :: Int) -- GHC specific
 
+{- Runs an action, watching a file as it grows and updating the meter. -}
+watchFileSize :: (MonadIO m, MonadMask m) => FilePath -> MeterUpdate -> m a -> m a
+watchFileSize f p a = bracket 
+       (liftIO $ forkIO $ watcher zeroBytesProcessed)
+       (liftIO . void . tryIO . killThread)
+       (const a)
+  where
+       watcher oldsz = do
+               v <- catchMaybeIO $ toBytesProcessed <$> getFileSize f
+               newsz <- case v of
+                       Just sz | sz /= oldsz -> do
+                               p sz
+                               return sz
+                       _ -> return oldsz
+               threadDelay 500000 -- 0.5 seconds
+               watcher newsz
+
 data OutputHandler = OutputHandler
        { quietMode :: Bool
        , stderrHandler :: String -> IO ()