generalize to allow running in Assistant monad

diff --git a/Messages/Concurrent.hs b/Messages/Concurrent.hs
index 94554aff5dbe776b7af5bffe0ac669a905554808..5e4138416e5df9868ba57670e94c09285f601f5c 100644 (file)
--- a/Messages/Concurrent.hs
+++ b/Messages/Concurrent.hs
@@ -98,10 +98,14 @@ inOwnConsoleRegion s a
                        Regions.closeConsoleRegion r
 
 {- The progress region is displayed inline with the current console region. -}
-withProgressRegion :: (Regions.ConsoleRegion -> Annex a) -> Annex a
-withProgressRegion a = do
-       parent <- consoleRegion <$> Annex.getState Annex.output
+withProgressRegion
+       :: (MonadIO m, MonadMask m)
+       => MessageState 
+       -> (Regions.ConsoleRegion -> m a) -> m a
+withProgressRegion st a =
        Regions.withConsoleRegion (maybe Regions.Linear Regions.InLine parent) a
+  where
+       parent = consoleRegion st
 
 instance Regions.LiftRegion Annex where
        liftRegion = liftIO . atomically

diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index 193bcb0f7bd4f16c3c208c8e7873da4d9a3e53a5..5767e2e8fecbaf0d72c30d6d57e14196df421807 100644 (file)
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -24,6 +24,7 @@ import Messages.Internal
 
 import qualified System.Console.Regions as Regions
 import qualified System.Console.Concurrent as Console
+import Control.Monad.IO.Class (MonadIO)
 
 {- Class of things from which a size can be gotten to display a progress
  - meter. -}
@@ -64,13 +65,30 @@ instance MeterSize KeySizer where
 {- Shows a progress meter while performing an action.
  - The action is passed the meter and a callback to use to update the meter.
  --}
-metered :: MeterSize sizer => Maybe MeterUpdate -> sizer -> (Meter -> MeterUpdate -> Annex a) -> Annex a
-metered othermeter sizer a = withMessageState $ \st ->
-       flip go st =<< getMeterSize sizer
+metered
+       :: MeterSize sizer
+       => Maybe MeterUpdate
+       -> sizer
+       -> (Meter -> MeterUpdate -> Annex a)
+       -> Annex a
+metered othermeter sizer a = withMessageState $ \st -> do
+       sz <- getMeterSize sizer
+       metered' st othermeter sz showOutput a
+
+metered'
+       :: (Monad m, MonadIO m, MonadMask m)
+       => MessageState
+       -> Maybe MeterUpdate
+       -> Maybe FileSize
+       -> m ()
+       -- ^ this should run showOutput
+       -> (Meter -> MeterUpdate -> m a)
+       -> m a
+metered' st othermeter size showoutput a = go size st
   where
        go _ (MessageState { outputType = QuietOutput }) = nometer
        go msize (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do
-               showOutput
+               showoutput
                meter <- liftIO $ mkMeter msize $ 
                        displayMeterHandle stdout bandwidthMeter
                m <- liftIO $ rateLimitMeterUpdate consoleratelimit meter $
@@ -79,7 +97,7 @@ metered othermeter sizer a = withMessageState $ \st ->
                liftIO $ clearMeterHandle meter stdout
                return r
        go msize (MessageState { outputType = NormalOutput, concurrentOutputEnabled = True }) =
-               withProgressRegion $ \r -> do
+               withProgressRegion st $ \r -> do
                        meter <- liftIO $ mkMeter msize $ \_ msize' old new ->
                                let s = bandwidthMeter msize' old new
                                in Regions.setConsoleRegion r ('\n' : s)
@@ -88,7 +106,7 @@ metered othermeter sizer a = withMessageState $ \st ->
                        a meter (combinemeter m)
        go msize (MessageState { outputType = JSONOutput jsonoptions })
                | jsonProgress jsonoptions = do
-                       buf <- withMessageState $ return . jsonBuffer
+                       let buf = jsonBuffer st
                        meter <- liftIO $ mkMeter msize $ \_ msize' _old new ->
                                JSON.progress buf msize' (meterBytesProcessed new)
                        m <- liftIO $ rateLimitMeterUpdate jsonratelimit meter $