diff options
| -rw-r--r-- | Remote/Git.hs | 15 | ||||
| -rw-r--r-- | Utility/Metered.hs | 19 |
2 files changed, 21 insertions, 13 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index 46b571a2e..d410db02f 100644 --- 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 60dcf7c74..da83fd8cd 100644 --- 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 () |