avoid watchFileSize running backward

This is groundwork for using watchFileSize for downloads from external
special remotes.

In Annex.Content.downloadUrl, this potentially avoids jitter in the
progress meter. When downloading with conduit, the meter gets updated based
on both the size of the file, and on the data flowing through conduit.
If that has not yet been flushed to the file, it seems possible for the
meter to run backwards when meter is updated with the file size.
It's probably only a few kb of jitter, so may not be visible.

Sponsored-by: Dartmouth College's DANDI project

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 4fddf43b511f2c3e7ffd10cee26edb3c798c0923..9c5d01cd83f27aba5434113b6d56c6febd39070f 100644 (file)
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -753,7 +753,7 @@ downloadUrl listfailedurls k p iv urls file uo =
        -- download command is used.
        meteredFile file (Just p) k (go urls [])
   where
-       go (u:us) errs = Url.download' p iv u file uo >>= \case
+       go (u:us) errs p' = Url.download' p' iv u file uo >>= \case
                Right () -> return True
                Left err -> do
                        -- If the incremental verifier was fed anything
@@ -765,9 +765,9 @@ downloadUrl listfailedurls k p iv urls file uo =
                                        Just n | n > 0 -> unableIncrementalVerifier iv'
                                        _ -> noop
                                Nothing -> noop
-                       go us ((u, err) : errs)
-       go [] [] = return False
-       go [] errs@((_, err):_) = do
+                       go us ((u, err) : errs) p'
+       go [] [] _ = return False
+       go [] errs@((_, err):_) _ = do
                if listfailedurls
                        then warning $ UnquotedString $
                                unlines $ flip map errs $ \(u, err') ->

diff --git a/Annex/CopyFile.hs b/Annex/CopyFile.hs
index 0be9debd5fde98c32ff325bb253052563c77416d..176f71c07691f77edf7b687680dda5ad19953417 100644 (file)
--- a/Annex/CopyFile.hs
+++ b/Annex/CopyFile.hs
@@ -57,7 +57,7 @@ tryCopyCoW (CopyCoWTried copycowtried) src dest meterupdate =
                        )
                )
   where
-       docopycow = watchFileSize dest meterupdate $
+       docopycow = watchFileSize dest meterupdate $ const $
                copyCoW CopyTimeStamps src dest
        
        dest' = toRawFilePath dest

diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index 4327e1970fc6e8b9dc5cfd0c19609f0d5da7a0ea..6392f12fa2da993becc168c03861da54d8a1ea4b 100644 (file)
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -171,7 +171,7 @@ metered' st setclear othermeterupdate msize bwlimit showoutput a = go st
        minratelimit = min consoleratelimit jsonratelimit
                
 {- Poll file size to display meter. -}
-meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> Annex a -> Annex a
+meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
 meteredFile file combinemeterupdate key a = 
        metered combinemeterupdate key Nothing $ \_ p ->
                watchFileSize file p a

diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index 7be8c9ec61d55a59db2fbb8e756a9f4824385fc9..b97516cb1a8bdf26226c2c74c126e429d72a8b08 100644 (file)
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -1,6 +1,6 @@
 {- Metered IO and actions
  -
- - Copyright 2012-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -218,23 +218,49 @@ defaultChunkSize = 32 * k - chunkOverhead
  - 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.
+ -
+ - An updated version of the MeterUpdate is passed to the action, and the
+ - action should use that for any updates that it makes. This allows for
+ - eg, the action updating the meter before a write is flushed to the file.
+ - In that situation, this avoids the meter being set back to the size of
+ - the file when it's gotten ahead of that point.
  -}
-watchFileSize :: (MonadIO m, MonadMask m) => FilePath -> MeterUpdate -> m a -> m a
-watchFileSize f p a = bracket 
-       (liftIO $ forkIO $ watcher =<< getsz)
-       (liftIO . void . tryIO . killThread)
-       (const a)
+watchFileSize
+       :: (MonadIO m, MonadMask m)
+       => FilePath
+       -> MeterUpdate
+       -> (MeterUpdate -> m a)
+       -> m a
+watchFileSize f p a = do
+       sizevar <- liftIO $ newMVar zeroBytesProcessed
+       bracket 
+               (liftIO $ forkIO $ watcher (meterupdate sizevar True) =<< getsz)
+               (liftIO . void . tryIO . killThread)
+               (const (a (meterupdate sizevar False)))
   where
-       watcher oldsz = do
+       watcher p' oldsz = do
                threadDelay 500000 -- 0.5 seconds
                sz <- getsz
                when (sz > oldsz) $
-                       p sz
-               watcher sz
+                       p' sz
+               watcher p' sz
        getsz = catchDefaultIO zeroBytesProcessed $
                toBytesProcessed <$> getFileSize f'
        f' = toRawFilePath f
 
+       meterupdate sizevar preventbacktracking n
+               | preventbacktracking = do
+                       old <- takeMVar sizevar
+                       if old > n
+                               then putMVar sizevar old
+                               else do
+                                       putMVar sizevar n
+                                       p n
+               | otherwise = do
+                       void $ takeMVar sizevar
+                       putMVar sizevar n
+                       p n
+
 data OutputHandler = OutputHandler
        { quietMode :: Bool
        , stderrHandler :: String -> IO ()