Concurrent progress bars are now displayed when using -J with a command that moves...

diff --git a/Messages/Concurrent.hs b/Messages/Concurrent.hs
index 5b125a97f159187a5a5988f3d2943149d54c5dd5..e4bc647b97ce5223b9fda30cdd0c0dce6c714570 100644 (file)
--- a/Messages/Concurrent.hs
+++ b/Messages/Concurrent.hs
@@ -98,7 +98,13 @@ inOwnConsoleRegion a = do
 inOwnConsoleRegion = id
 #endif
 
+{- The progress region is displayed inline with the current console region. -}
 #ifdef WITH_CONCURRENTOUTPUT
+withProgressRegion :: (Regions.ConsoleRegion -> Annex a) -> Annex a
+withProgressRegion a = do
+       parent <- consoleRegion <$> Annex.getState Annex.output
+       Regions.withConsoleRegion (maybe Regions.Linear Regions.InLine parent) a
+
 instance Regions.LiftRegion Annex where
        liftRegion = liftIO . atomically
 #endif

diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index 89f2f0c8c2f51ae2c36c94742156bfd0764c2efc..24a68c922af636fe1c8f176810399fa885862a66 100644 (file)
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -18,10 +18,11 @@ import Types.Messages
 import Types.Key
 
 #ifdef WITH_CONCURRENTOUTPUT
-import System.Console.Concurrent
-import System.Console.Regions
-import Control.Concurrent
+import Messages.Concurrent
+import qualified System.Console.Regions as Regions
+import qualified System.Console.Concurrent as Console
 #endif
+
 import Data.Progress.Meter
 import Data.Progress.Tracker
 import Data.Quantity
@@ -29,65 +30,37 @@ import Data.Quantity
 {- Shows a progress meter while performing a transfer of a key.
  - The action is passed a callback to use to update the meter. -}
 metered :: Maybe MeterUpdate -> Key -> AssociatedFile -> (MeterUpdate -> Annex a) -> Annex a
-metered combinemeterupdate key af a = case keySize key of
+metered combinemeterupdate key _af a = case keySize key of
        Nothing -> nometer
        Just size -> withOutputType (go $ fromInteger size)
   where
        go _ QuietOutput = nometer
        go _ JSONOutput = nometer
-#if 0
-       go size _ = do
-               showOutput
-               liftIO $ putStrLn ""
-
-               cols <- liftIO $ maybe 79 Terminal.width <$> Terminal.size
-               let desc = truncatepretty cols $ fromMaybe (key2file key) af
-
-               result <- liftIO newEmptyMVar
-               pg <- liftIO $ newProgressBar def
-                       { pgWidth = cols
-                       , pgFormat = desc ++ " :percent :bar ETA :eta"
-                       , pgTotal = size
-                       , pgOnCompletion = do
-                               ok <- takeMVar result
-                               putStrLn $ desc ++ " " ++ endResult ok
-                       }
-               r <- a $ liftIO . pupdate pg
-
-               liftIO $ do
-                       -- See if the progress bar is complete or not.
-                       sofar <- stCompleted <$> getProgressStats pg
-                       putMVar result (sofar >= size)
-                       -- May not be actually complete if the action failed,
-                       -- but this just clears the progress bar.
-                       complete pg
-
-               return r
-#else
-       -- Old progress bar code, not suitable for concurrent output.
-       go _ (ConcurrentOutput _) = nometer
        go size NormalOutput = do
                showOutput
-               progress <- liftIO $ newProgress "" size
-               meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
-               r <- a $ liftIO . pupdate meter progress
+               (progress, meter) <- mkmeter size
+               r <- a $ \n -> liftIO $ do
+                       setP progress $ fromBytesProcessed n
+                       displayMeter stdout meter
+                       maybe noop (\m -> m n) combinemeterupdate
                liftIO $ clearMeter stdout meter
                return r
-#endif
-
-#if 0
-       pupdate pg n = do
-               let i = fromBytesProcessed n
-               sofar <- stCompleted <$> getProgressStats pg
-               when (i > sofar) $
-                       tickN pg (i - sofar)
-               threadDelay 100
+#if WITH_CONCURRENTOUTPUT
+       go size (ConcurrentOutput _) = withProgressRegion $ \r -> do
+               (progress, meter) <- mkmeter size
+               a $ \n -> liftIO $ do
+                       setP progress $ fromBytesProcessed n
+                       s <- renderMeter meter
+                       Regions.setConsoleRegion r ("\n" ++ s)
+                       maybe noop (\m -> m n) combinemeterupdate
 #else
-       pupdate meter progress n = do
-               setP progress $ fromBytesProcessed n
-               displayMeter stdout meter
+       go _ (ConcurrentOutput _) = nometer
 #endif
-               maybe noop (\m -> m n) combinemeterupdate
+
+       mkmeter size = do
+               progress <- liftIO $ newProgress "" size
+               meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
+               return (progress, meter)
 
        nometer = a (const noop)
 
@@ -139,6 +112,6 @@ mkStderrEmitter :: Annex (String -> IO ())
 mkStderrEmitter = withOutputType go
   where
 #ifdef WITH_CONCURRENTOUTPUT
-       go (ConcurrentOutput _) = return errorConcurrent
+       go (ConcurrentOutput _) = return Console.errorConcurrent
 #endif
        go _ = return (hPutStrLn stderr)

diff --git a/debian/changelog b/debian/changelog
index c0d4c510d5e1242ba9bae7314c0e3e5e1e882cf3..2a05e8b0b8c911231b08410c7c7193c9a19d6b21 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,8 @@ git-annex (5.20151102.2) UNRELEASED; urgency=medium
     fsck, drop, add, addurl, import
   * import: Avoid very ugly error messages when the directory files
     are imported to is not a directort, but perhaps an annexed file.
+  * Concurrent progress bars are now displayed when using -J with a command
+    that moves file contents around.
 
  -- Joey Hess <id@joeyh.name>  Wed, 04 Nov 2015 12:50:20 -0400