make metered more generic

Allow it to be used when the Key is not known.

Annex/Import.hs

@@ -360,7 +360,7 @@ downloadImport remote importtreeconfig importablecontents = do
 				Nothing -> return Nothing
 		checkDiskSpaceToGet tmpkey Nothing $
 			withTmp tmpkey $ \tmpfile ->
-				metered Nothing tmpkey (return Nothing) $
+				metered Nothing tmpkey $
 					const (rundownload tmpfile)
 	  where
 		ia = Remote.importActions remote

Messages/Progress.hs

@@ -1,10 +1,12 @@
 {- git-annex progress output
  -
- - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE FlexibleInstances #-}
+
 module Messages.Progress where
 
 import Common
@@ -19,16 +21,38 @@ import Messages.Concurrent
 import qualified System.Console.Regions as Regions
 import qualified System.Console.Concurrent as Console
 
-{- Shows a progress meter while performing a transfer of a key.
+{- Class of things from which a size can be gotten to display a progress
- - The action is passed the meter and a callback to use to update the meter.
+ - meter. -}
- -
+class MeterSize t where
- - When the key's size is not known, the srcfile is statted to get the size.
+	getMeterSize :: t -> Annex (Maybe Integer)
+
+instance MeterSize (Maybe Integer) where
+	getMeterSize = pure
+
+instance MeterSize Key where
+	getMeterSize = pure . keySize
+
+{- When the key's size is not known, the file is statted to get the size.
  - This allows uploads of keys without size to still have progress
  - displayed.
+ -}
+data KeySizer = KeySizer Key (Annex (Maybe FilePath))
+
+instance MeterSize KeySizer where
+	getMeterSize (KeySizer k getsrcfile) = case keySize k of
+		Just sz -> return (Just sz)
+		Nothing -> do
+			srcfile <- getsrcfile
+			case srcfile of
+				Nothing -> return Nothing
+				Just f -> catchMaybeIO $ liftIO $ 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.
  --}
-metered :: Maybe MeterUpdate -> Key -> Annex (Maybe FilePath) -> (Meter -> MeterUpdate -> Annex a) -> Annex a
+metered :: MeterSize sizer => Maybe MeterUpdate -> sizer -> (Meter -> MeterUpdate -> Annex a) -> Annex a
-metered othermeter key getsrcfile a = withMessageState $ \st ->
+metered othermeter sizer a = withMessageState $ \st ->
-	flip go st =<< getsz
+	flip go st =<< getMeterSize sizer
   where
 	go _ (MessageState { outputType = QuietOutput }) = nometer
 	go msize (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do
@@ -66,19 +90,11 @@ metered othermeter key getsrcfile a = withMessageState $ \st ->
 	combinemeter m = case othermeter of
 		Nothing -> m
 		Just om -> combineMeterUpdate m om
-	
-	getsz = case keySize key of
-		Just sz -> return (Just sz)
-		Nothing -> do
-			srcfile <- getsrcfile
-			case srcfile of
-				Nothing -> return Nothing
-				Just f -> catchMaybeIO $ liftIO $ getFileSize f
 
 {- Poll file size to display meter. -}
 meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> Annex a -> Annex a
 meteredFile file combinemeterupdate key a = 
-	metered combinemeterupdate key (return Nothing) $ \_ p ->
+	metered combinemeterupdate key $ \_ p ->
 		watchFileSize file p a
 
 {- Progress dots. -}

Remote/Helper/P2P.hs

@@ -32,14 +32,14 @@ type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) ->
 
 store :: (MeterUpdate -> ProtoRunner Bool) -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store runner k af p = do
-	let getsrcfile = fmap fst <$> prepSendAnnex k
+	let sizer = KeySizer k (fmap fst <$> prepSendAnnex k)
-	metered (Just p) k getsrcfile $ \_ p' -> 
+	metered (Just p) sizer $ \_ p' -> 
 		fromMaybe False
 			<$> runner p' (P2P.put k af p')
 
 retrieve :: (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
 retrieve runner k af dest p =
-	metered (Just p) k (return Nothing) $ \m p' -> 
+	metered (Just p) k $ \m p' -> 
 		fromMaybe (False, UnVerified)
 			<$> runner p' (P2P.get dest k af m p')
 

Remote/Helper/Special.hs

@@ -253,7 +253,8 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 	chunkconfig = chunkConfig cfg
 
 	displayprogress p k srcfile a
-		| displayProgress cfg = metered (Just p) k (return srcfile) (const a)
+		| displayProgress cfg =
+			metered (Just p) (KeySizer k (return srcfile)) (const a)
 		| otherwise = a p
 
 {- Sink callback for retrieveChunks. Stores the file content into the