summaryrefslogtreecommitdiff
path: root/Messages
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-11-06 13:44:57 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-11-06 13:44:57 -0400
commit22b30805290ccd3ac1bc467c113c8560ec4f114f (patch)
tree3f64ae66e9ad605d6ea621aa6a3ee2f5c8fa4bd1 /Messages
parentb6f03f9298265d559e5918fa89e482ea3a2483a9 (diff)
Concurrent progress bars are now displayed when using -J with a command that moves file contents around.
Diffstat (limited to 'Messages')
-rw-r--r--Messages/Concurrent.hs6
-rw-r--r--Messages/Progress.hs77
2 files changed, 31 insertions, 52 deletions
diff --git a/Messages/Concurrent.hs b/Messages/Concurrent.hs
index 5b125a97f..e4bc647b9 100644
--- 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 89f2f0c8c..24a68c922 100644
--- 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)