use TotalSize more extensively
This commit is contained in:
parent
263fd1d459
commit
94b323a8e8
6 changed files with 48 additions and 35 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue