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.

diff --git a/Messages.hs b/Messages.hs
index d3e63458ad16a3c0b0c80dc276c613ab2b151256..2940b3f53929eb4bcccc90b792a6d3ae9b61b1d2 100644 (file)
--- a/Messages.hs
+++ b/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 $

diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 79829ac1512fe808662faf7b222e6226e571c42d..7c84b8431eb653194e6c35880a08ebc0a3bd934b 100644 (file)
--- a/Messages/Internal.hs
+++ b/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

diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index a8588614c24677db2cdaeeae4ec1bd3dc0b86dfb..9dec9a9ca9dac0fce5078640b3322169dc374ef4 100644 (file)
--- a/Messages/Progress.hs
+++ b/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 = 

diff --git a/Types/Messages.hs b/Types/Messages.hs
index f4319d9cfbc55f6039286ef864fde34421a44913..22346120c8b2ea2f97243485bcb76ca349bd2129 100644 (file)
--- a/Types/Messages.hs
+++ b/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)

diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index 3e2333cc716d3522b6cae0e782675197b1c1043b..338bb0e6e0a5b7d718984b300a13277c4114795c 100644 (file)
--- a/Utility/Metered.hs
+++ b/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"