use TotalSize more extensively

diff --git a/Messages/JSON.hs b/Messages/JSON.hs
index d423f62e9df837fddddf675fcbf0da873efb6cdf..2b9f6d77a4f334f0112a80f953505e9f6a189b83 100644 (file)
--- a/Messages/JSON.hs
+++ b/Messages/JSON.hs
@@ -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

diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index 8fd056e9014044927a9aa3079dfc1b9471b5ffa2..a315a39220168b4b38848f89905b56d660a7e3a1 100644 (file)
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -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)

diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs
index a1aa66b5812316ffe3c6d8dbd12d08577f523005..13d5ea8c3f20beb3f25b306cca50b39856c8e6ba 100644 (file)
--- a/P2P/Protocol.hs
+++ b/P2P/Protocol.hs
@@ -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

diff --git a/Types/Messages.hs b/Types/Messages.hs
index 16d1d249930dd945ff3635067113a8061ab62a67..d2493d4177260dfb0b6c18fd00542272597e9b96 100644 (file)
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -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

diff --git a/Types/Transferrer.hs b/Types/Transferrer.hs
index f4b38e7c754a1a07e61a7207f1bedc5675ed438a..afeda7c5ebaee8e76788eb453c4d1ab60bd11336 100644 (file)
--- a/Types/Transferrer.hs
+++ b/Types/Transferrer.hs
@@ -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

diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index b4e4024a67f979eea6835244b80d225410007df1..1715f0bf77f3a938b1155da22a4bfc8263fe341c 100644 (file)
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -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