From 5c874fd5f5f6dcdf2889d3db7d4429553859ccd6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 25 May 2017 14:30:18 -0400 Subject: Improve progress display when watching file size, in cases where a transfer does not resume. This commit was supported by the NSF-funded DataLad project. --- Utility/Metered.hs | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) (limited to 'Utility') diff --git a/Utility/Metered.hs b/Utility/Metered.hs index 626aa2ca1..a5dda5413 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -171,22 +171,27 @@ 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. -} +{- Runs an action, watching a file as it grows and updating the meter. + - + - The file may already exist, and the action could throw the original file + - away and start over. To avoid reporting the original file size followed + - by a smaller size in that case, wait until the file starts growing + - before updating the meter for the first time. + -} watchFileSize :: (MonadIO m, MonadMask m) => FilePath -> MeterUpdate -> m a -> m a watchFileSize f p a = bracket - (liftIO $ forkIO $ watcher zeroBytesProcessed) + (liftIO $ forkIO $ watcher =<< getsz) (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 + sz <- getsz + when (sz > oldsz) $ + p sz + watcher sz + getsz = catchDefaultIO zeroBytesProcessed $ + toBytesProcessed <$> getFileSize f data OutputHandler = OutputHandler { quietMode :: Bool -- cgit v1.2.3