From 4efecaebd65eab2e5aa1d4f9704fa9b59fe967e4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 4 Dec 2020 13:07:30 -0400
Subject: [PATCH] generalize to allow running in Assistant monad

---
 Messages/Concurrent.hs | 10 +++++++---
 Messages/Progress.hs   | 30 ++++++++++++++++++++++++------
 2 files changed, 31 insertions(+), 9 deletions(-)

diff --git a/Messages/Concurrent.hs b/Messages/Concurrent.hs
index 94554aff5d..5e4138416e 100644
--- 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 193bcb0f7b..5767e2e8fe 100644
--- 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 $