use TotalSize more extensively

This commit is contained in:
Joey Hess 2020-12-11 12:03:40 -04:00
parent 263fd1d459
commit 94b323a8e8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 48 additions and 35 deletions

View file

@ -134,7 +134,7 @@ complete v _ = add v (Just (HM.empty, True))
-- Show JSON formatted progress, including the current state of the JSON
-- object for the action being performed.
progress :: Maybe Object -> Maybe Integer -> BytesProcessed -> IO ()
progress :: Maybe Object -> Maybe TotalSize -> BytesProcessed -> IO ()
progress maction msize bytesprocessed =
case j of
Object o -> emit $ case maction of
@ -144,7 +144,7 @@ progress maction msize bytesprocessed =
where
n = fromBytesProcessed bytesprocessed :: Integer
j = case msize of
Just size -> object
Just (TotalSize size) -> object
[ "byte-progress" .= n
, "percent-progress" .= showPercentage 2 (percentage size n)
, "total-size" .= size

View file

@ -29,20 +29,20 @@ import Control.Monad.IO.Class (MonadIO)
{- Class of things from which a size can be gotten to display a progress
- meter. -}
class MeterSize t where
getMeterSize :: t -> Annex (Maybe FileSize)
getMeterSize :: t -> Annex (Maybe TotalSize)
instance MeterSize t => MeterSize (Maybe t) where
getMeterSize Nothing = pure Nothing
getMeterSize (Just t) = getMeterSize t
instance MeterSize FileSize where
getMeterSize = pure . Just
getMeterSize = pure . Just . TotalSize
instance MeterSize Key where
getMeterSize = pure . fromKey keySize
getMeterSize = pure . fmap TotalSize . fromKey keySize
instance MeterSize InodeCache where
getMeterSize = pure . Just . inodeCacheFileSize
getMeterSize = pure . Just . TotalSize . inodeCacheFileSize
instance MeterSize KeySource where
getMeterSize = maybe (pure Nothing) getMeterSize . inodeCache
@ -55,12 +55,13 @@ data KeySizer = KeySizer Key (Annex (Maybe RawFilePath))
instance MeterSize KeySizer where
getMeterSize (KeySizer k getsrcfile) = case fromKey keySize k of
Just sz -> return (Just sz)
Just sz -> return (Just (TotalSize sz))
Nothing -> do
srcfile <- getsrcfile
case srcfile of
Nothing -> return Nothing
Just f -> catchMaybeIO $ liftIO $ getFileSize f
Just f -> catchMaybeIO $ liftIO $
TotalSize <$> getFileSize f
{- Shows a progress meter while performing an action.
- The action is passed the meter and a callback to use to update the meter.
@ -79,7 +80,7 @@ metered'
:: (Monad m, MonadIO m, MonadMask m)
=> MessageState
-> Maybe MeterUpdate
-> Maybe FileSize
-> Maybe TotalSize
-> m ()
-- ^ this should run showOutput
-> (Meter -> MeterUpdate -> m a)

View file

@ -281,7 +281,7 @@ data LocalF c
-- present, runs the protocol action with False.
| WaitRefChange (ChangedRefs -> c)
-- ^ Waits for one or more git refs to change and returns them.a
| UpdateMeterTotalSize Meter Integer c
| UpdateMeterTotalSize Meter TotalSize c
-- ^ Updates the total size of a Meter, for cases where the size is
-- not known until the data is being received.
| RunValidityCheck (Annex Validity) (Validity -> c)
@ -548,7 +548,7 @@ receiveContent mm p sizer storer mkmsg = do
Just (DATA len@(Len l)) -> do
local $ case mm of
Nothing -> return ()
Just m -> updateMeterTotalSize m (n+l)
Just m -> updateMeterTotalSize m (TotalSize (n+l))
ver <- net getProtocolVersion
let validitycheck = if ver >= ProtocolVersion 1
then net receiveMessage >>= \case

View file

@ -9,7 +9,6 @@ module Types.Messages where
import qualified Utility.Aeson as Aeson
import Utility.Metered
import Utility.FileSize
import Control.Concurrent
import System.Console.Regions (ConsoleRegion)
@ -69,7 +68,7 @@ newMessageState = do
data SerializedOutput
= OutputMessage S.ByteString
| OutputError String
| StartProgressMeter (Maybe FileSize)
| StartProgressMeter (Maybe TotalSize)
| UpdateProgressMeter BytesProcessed
| EndProgressMeter
| StartPrompt

View file

@ -12,6 +12,7 @@ import Types.Messages
import Git.Types (RemoteName)
import qualified Utility.SimpleProtocol as Proto
import Utility.Format
import Utility.Metered (TotalSize(..))
import Data.Char
@ -84,7 +85,7 @@ instance Proto.Sendable TransferResponse where
["om", Proto.serialize (encode_c (decodeBS m))]
formatMessage (TransferOutput (OutputError e)) =
["oe", Proto.serialize (encode_c e)]
formatMessage (TransferOutput (StartProgressMeter (Just n))) =
formatMessage (TransferOutput (StartProgressMeter (Just (TotalSize n)))) =
["ops", Proto.serialize n]
formatMessage (TransferOutput (StartProgressMeter Nothing)) =
["opsx"]
@ -104,17 +105,28 @@ instance Proto.Sendable TransferResponse where
["f"]
instance Proto.Receivable TransferResponse where
parseCommand "om" = Proto.parse1 (TransferOutput . OutputMessage . encodeBS . decode_c)
parseCommand "oe" = Proto.parse1 (TransferOutput . OutputError . decode_c)
parseCommand "ops" = Proto.parse1 (TransferOutput . StartProgressMeter . Just)
parseCommand "opsx" = Proto.parse0 (TransferOutput (StartProgressMeter Nothing))
parseCommand "op" = Proto.parse1 (TransferOutput . UpdateProgressMeter)
parseCommand "ope" = Proto.parse0 (TransferOutput EndProgressMeter)
parseCommand "oprs" = Proto.parse0 (TransferOutput StartPrompt)
parseCommand "opre" = Proto.parse0 (TransferOutput EndPrompt)
parseCommand "oj" = Proto.parse1 (TransferOutput . JSONObject . encodeBL . decode_c)
parseCommand "t" = Proto.parse0 (TransferResult True)
parseCommand "f" = Proto.parse0 (TransferResult False)
parseCommand "om" = Proto.parse1 $
TransferOutput . OutputMessage . encodeBS . decode_c
parseCommand "oe" = Proto.parse1 $
TransferOutput . OutputError . decode_c
parseCommand "ops" = Proto.parse1 $
TransferOutput . StartProgressMeter . Just . TotalSize
parseCommand "opsx" = Proto.parse0 $
TransferOutput (StartProgressMeter Nothing)
parseCommand "op" = Proto.parse1 $
TransferOutput . UpdateProgressMeter
parseCommand "ope" = Proto.parse0 $
TransferOutput EndProgressMeter
parseCommand "oprs" = Proto.parse0 $
TransferOutput StartPrompt
parseCommand "opre" = Proto.parse0 $
TransferOutput EndPrompt
parseCommand "oj" = Proto.parse1 $
TransferOutput . JSONObject . encodeBL . decode_c
parseCommand "t" = Proto.parse0 $
TransferResult True
parseCommand "f" = Proto.parse0 $
TransferResult False
parseCommand _ = Proto.parseFail
instance Proto.Sendable TransferSerializedOutputResponse where

View file

@ -242,6 +242,7 @@ data OutputHandler = OutputHandler
type ProgressParser = String -> (Maybe BytesProcessed, Maybe TotalSize, String)
newtype TotalSize = TotalSize Integer
deriving (Show, Eq)
{- Runs a command and runs a ProgressParser on its output, in order
- to update a meter.
@ -281,8 +282,8 @@ commandMeterExitCode' progressparser oh mmeter meterupdate cmd params mkprocess
let s = decodeBS b
let (mbytes, mtotalsize, buf') = progressparser (buf++s)
sendtotalsize' <- case (sendtotalsize, mtotalsize) of
(Just meter, Just (TotalSize n)) -> do
setMeterTotalSize meter n
(Just meter, Just t) -> do
setMeterTotalSize meter t
return Nothing
_ -> return sendtotalsize
case mbytes of
@ -368,7 +369,7 @@ rateLimitMeterUpdate delta (Meter totalsizev _ _ _) meterupdate = do
return $ mu lastupdate
where
mu lastupdate n@(BytesProcessed i) = readMVar totalsizev >>= \case
Just t | i >= t -> meterupdate n
Just (TotalSize t) | i >= t -> meterupdate n
_ -> do
now <- getPOSIXTime
prev <- takeMVar lastupdate
@ -378,19 +379,19 @@ rateLimitMeterUpdate delta (Meter totalsizev _ _ _) meterupdate = do
meterupdate n
else putMVar lastupdate prev
data Meter = Meter (MVar (Maybe Integer)) (MVar MeterState) (MVar String) DisplayMeter
data Meter = Meter (MVar (Maybe TotalSize)) (MVar MeterState) (MVar String) DisplayMeter
data MeterState = MeterState
{ meterBytesProcessed :: BytesProcessed
, meterTimeStamp :: POSIXTime
} deriving (Show)
type DisplayMeter = MVar String -> Maybe Integer -> MeterState -> MeterState -> IO ()
type DisplayMeter = MVar String -> Maybe TotalSize -> MeterState -> MeterState -> IO ()
type RenderMeter = Maybe Integer -> MeterState -> MeterState -> String
type RenderMeter = Maybe TotalSize -> MeterState -> MeterState -> String
-- | Make a meter. Pass the total size, if it's known.
mkMeter :: Maybe Integer -> DisplayMeter -> IO Meter
mkMeter :: Maybe TotalSize -> DisplayMeter -> IO Meter
mkMeter totalsize displaymeter = do
ts <- getPOSIXTime
Meter
@ -399,7 +400,7 @@ mkMeter totalsize displaymeter = do
<*> newMVar ""
<*> pure displaymeter
setMeterTotalSize :: Meter -> Integer -> IO ()
setMeterTotalSize :: Meter -> TotalSize -> IO ()
setMeterTotalSize (Meter totalsizev _ _ _) = void . swapMVar totalsizev . Just
-- | Updates the meter, displaying it if necessary.
@ -446,7 +447,7 @@ bandwidthMeter mtotalsize (MeterState (BytesProcessed old) before) (MeterState (
where
amount = roughSize' memoryUnits True 2 new
percentamount = case mtotalsize of
Just totalsize ->
Just (TotalSize totalsize) ->
let p = showPercentage 0 $
percentage totalsize (min new totalsize)
in p ++ replicate (6 - length p) ' ' ++ amount
@ -458,7 +459,7 @@ bandwidthMeter mtotalsize (MeterState (BytesProcessed old) before) (MeterState (
transferred = max 0 (new - old)
duration = max 0 (now - before)
estimatedcompletion = case mtotalsize of
Just totalsize
Just (TotalSize totalsize)
| bytespersecond > 0 ->
Just $ fromDuration $ Duration $
(totalsize - new) `div` bytespersecond