start on serializing Messages

Json objects not yet handled, and some other special cases, but this is
the bulk of the messages.

For progress meters, POSIXTime does not have a Read instance (or a
suitable Show instance), so had to switch to using a Double for progress
meters.

This commit was sponsored by Ethan Aubin on Patreon.

Messages.hs

@@ -285,9 +285,10 @@ debugEnabled = do
 commandProgressDisabled :: Annex Bool
 commandProgressDisabled = withMessageState $ \s -> return $
 	case outputType s of
+		NormalOutput -> concurrentOutputEnabled s
 		QuietOutput -> True
 		JSONOutput _ -> True
-		NormalOutput -> concurrentOutputEnabled s
+		SerializedOutput -> True
 
 jsonOutputEnabled :: Annex Bool
 jsonOutputEnabled = withMessageState $ \s -> return $

Messages/Internal.hs

@@ -1,6 +1,6 @@
 {- git-annex output messages, including concurrent output to display regions
  -
- - Copyright 2010-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -29,6 +29,7 @@ outputMessage' jsonoutputter jsonbuilder msg = withMessageState $ \s -> case out
 		| otherwise -> liftIO $ flushed $ S.putStr msg
 	JSONOutput _ -> void $ jsonoutputter jsonbuilder s
 	QuietOutput -> q
+	SerializedOutput -> liftIO $ outputSerialized $ OutputMessage (decodeBS' msg)
 
 -- Buffer changes to JSON until end is reached and then emit it.
 bufferJSON :: JSONBuilder -> MessageState -> Annex Bool
@@ -67,6 +68,8 @@ outputError msg = withMessageState $ \s -> case (outputType s, jsonBuffer s) of
 		let jb' = Just (JSON.addErrorMessage (lines msg) jb)
 		in Annex.changeState $ \st ->
 			st { Annex.output = s { jsonBuffer = jb' } }
+	(SerializedOutput, _) -> 
+		liftIO $ outputSerialized $ OutputError msg
 	_
 		| concurrentOutputEnabled s -> concurrentMessage s True msg go
 		| otherwise -> go
@@ -81,3 +84,6 @@ q = noop
 
 flushed :: IO () -> IO ()
 flushed a = a >> hFlush stdout
+
+outputSerialized :: SerializedOutput -> IO ()
+outputSerialized = print

Messages/Progress.hs

@@ -1,6 +1,6 @@
 {- git-annex progress output
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -20,6 +20,7 @@ import Types.KeySource
 import Utility.InodeCache
 import qualified Messages.JSON as JSON
 import Messages.Concurrent
+import Messages.Internal
 
 import qualified System.Console.Regions as Regions
 import qualified System.Console.Concurrent as Console
@@ -72,7 +73,7 @@ metered othermeter sizer a = withMessageState $ \st ->
 		showOutput
 		meter <- liftIO $ mkMeter msize $ 
 			displayMeterHandle stdout bandwidthMeter
-		m <- liftIO $ rateLimitMeterUpdate 0.2 meter $
+		m <- liftIO $ rateLimitMeterUpdate consoleratelimit meter $
 			updateMeter meter
 		r <- a meter (combinemeter m)
 		liftIO $ clearMeterHandle meter stdout
@@ -82,19 +83,24 @@ metered othermeter sizer a = withMessageState $ \st ->
 			meter <- liftIO $ mkMeter msize $ \_ msize' old new ->
 				let s = bandwidthMeter msize' old new
 				in Regions.setConsoleRegion r ('\n' : s)
-			m <- liftIO $ rateLimitMeterUpdate 0.2 meter $
+			m <- liftIO $ rateLimitMeterUpdate consoleratelimit meter $
 				updateMeter meter
 			a meter (combinemeter m)
 	go msize (MessageState { outputType = JSONOutput jsonoptions })
 		| jsonProgress jsonoptions = do
 			buf <- withMessageState $ return . jsonBuffer
-			meter <- liftIO $ mkMeter msize $ \_ msize' _old (new, _now) ->
-				JSON.progress buf msize' new
-			m <- liftIO $ rateLimitMeterUpdate 0.1 meter $
+			meter <- liftIO $ mkMeter msize $ \_ msize' _old new ->
+				JSON.progress buf msize' (meterBytesProcessed new)
+			m <- liftIO $ rateLimitMeterUpdate jsonratelimit meter $
 				updateMeter meter
 			a meter (combinemeter m)
 		| otherwise = nometer
-
+	go msize (MessageState { outputType = SerializedOutput }) = do
+		meter <- liftIO $ mkMeter msize $ \_ msize' old new ->
+			outputSerialized $ ProgressMeter msize' old new
+		m <- liftIO $ rateLimitMeterUpdate minratelimit meter $
+			updateMeter meter
+		a meter (combinemeter m)
 	nometer = do
 		dummymeter <- liftIO $ mkMeter Nothing $
 			\_ _ _ _ -> return ()
@@ -104,6 +110,12 @@ metered othermeter sizer a = withMessageState $ \st ->
 		Nothing -> m
 		Just om -> combineMeterUpdate m om
 
+	consoleratelimit = 0.2
+
+	jsonratelimit = 0.1
+
+	minratelimit = min consoleratelimit jsonratelimit
+
 {- Poll file size to display meter. -}
 meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> Annex a -> Annex a
 meteredFile file combinemeterupdate key a = 

Types/Messages.hs

@@ -1,6 +1,6 @@
 {- git-annex Messages data types
  - 
- - Copyright 2012-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -8,11 +8,16 @@
 module Types.Messages where
 
 import qualified Utility.Aeson as Aeson
+import Utility.Metered
 
 import Control.Concurrent
 import System.Console.Regions (ConsoleRegion)
 
-data OutputType = NormalOutput | QuietOutput | JSONOutput JSONOptions
+data OutputType
+	= NormalOutput
+	| QuietOutput
+	| JSONOutput JSONOptions
+	| SerializedOutput
 	deriving (Show)
 
 data JSONOptions = JSONOptions
@@ -53,3 +58,9 @@ newMessageState = do
 		, jsonBuffer = Nothing
 		, promptLock = promptlock
 		}
+
+data SerializedOutput
+	= OutputMessage String
+	| OutputError String
+	| ProgressMeter (Maybe Integer) MeterState MeterState
+	deriving (Show, Read)

Utility/Metered.hs

@@ -9,6 +9,7 @@
 
 module Utility.Metered (
 	MeterUpdate,
+	MeterState(..),
 	nullMeterUpdate,
 	combineMeterUpdate,
 	TotalSize(..),
@@ -77,7 +78,7 @@ combineMeterUpdate a b = \n -> a n >> b n
 
 {- Total number of bytes processed so far. -}
 newtype BytesProcessed = BytesProcessed Integer
-	deriving (Eq, Ord, Show)
+	deriving (Eq, Ord, Show, Read)
 
 class AsBytesProcessed a where
 	toBytesProcessed :: a -> BytesProcessed
@@ -379,19 +380,24 @@ rateLimitMeterUpdate delta (Meter totalsizev _ _ _) meterupdate = do
 
 data Meter = Meter (MVar (Maybe Integer)) (MVar MeterState) (MVar String) DisplayMeter
 
-type MeterState = (BytesProcessed, POSIXTime)
+data MeterState = MeterState
+	{ meterBytesProcessed :: BytesProcessed
+	, meterTimeStamp :: Double
+	} deriving (Show, Read)
 
-type DisplayMeter = MVar String -> Maybe Integer -> (BytesProcessed, POSIXTime) -> (BytesProcessed, POSIXTime) -> IO ()
+type DisplayMeter = MVar String -> Maybe Integer -> MeterState -> MeterState -> IO ()
 
-type RenderMeter = Maybe Integer -> (BytesProcessed, POSIXTime) -> (BytesProcessed, POSIXTime) -> String
+type RenderMeter = Maybe Integer -> MeterState -> MeterState -> String
 
 -- | Make a meter. Pass the total size, if it's known.
 mkMeter :: Maybe Integer -> DisplayMeter -> IO Meter
-mkMeter totalsize displaymeter = Meter
-	<$> newMVar totalsize
-	<*> ((\t -> newMVar (zeroBytesProcessed, t)) =<< getPOSIXTime)
-	<*> newMVar ""
-	<*> pure displaymeter
+mkMeter totalsize displaymeter = do
+	ts <- realToFrac <$> getPOSIXTime
+	Meter
+		<$> newMVar totalsize
+		<*> newMVar (MeterState zeroBytesProcessed ts)
+		<*> newMVar ""
+		<*> pure displaymeter
 
 setMeterTotalSize :: Meter -> Integer -> IO ()
 setMeterTotalSize (Meter totalsizev _ _ _) = void . swapMVar totalsizev . Just
@@ -399,11 +405,12 @@ setMeterTotalSize (Meter totalsizev _ _ _) = void . swapMVar totalsizev . Just
 -- | Updates the meter, displaying it if necessary.
 updateMeter :: Meter -> MeterUpdate
 updateMeter (Meter totalsizev sv bv displaymeter) new = do
-	now <- getPOSIXTime
-	(old, before) <- swapMVar sv (new, now)
-	when (old /= new) $ do
+	now <- realToFrac <$> getPOSIXTime
+	let curms = MeterState new now
+	oldms <- swapMVar sv curms
+	when (meterBytesProcessed oldms /= new) $ do
 		totalsize <- readMVar totalsizev
-		displaymeter bv totalsize (old, before) (new, now)
+		displaymeter bv totalsize oldms curms
 
 -- | Display meter to a Handle.
 displayMeterHandle :: Handle -> RenderMeter -> DisplayMeter
@@ -428,7 +435,7 @@ clearMeterHandle (Meter _ _ v _) h = do
 -- or when total size is not known:
 --   1.3 MiB      300 KiB/s
 bandwidthMeter :: RenderMeter
-bandwidthMeter mtotalsize (BytesProcessed old, before) (BytesProcessed new, now) =
+bandwidthMeter mtotalsize (MeterState (BytesProcessed old) before) (MeterState (BytesProcessed new) now) =
 	unwords $ catMaybes
 		[ Just percentamount
 		-- Pad enough for max width: "100%  xxxx.xx KiB  xxxx KiB/s"