make metered more generic

Allow it to be used when the Key is not known.
This commit is contained in:
Joey Hess 2019-06-25 12:30:18 -04:00
parent 8355dba5cc
commit 26c54d6ea3
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 39 additions and 22 deletions

View file

@ -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

View file

@ -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.
- The action is passed the meter and a callback to use to update the meter.
-
- When the key's size is not known, the srcfile is statted to get the size.
{- Class of things from which a size can be gotten to display a progress
- meter. -}
class MeterSize t where
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 othermeter key getsrcfile a = withMessageState $ \st ->
flip go st =<< getsz
metered :: MeterSize sizer => Maybe MeterUpdate -> sizer -> (Meter -> MeterUpdate -> Annex a) -> Annex a
metered othermeter sizer a = withMessageState $ \st ->
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. -}

View file

@ -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
metered (Just p) k getsrcfile $ \_ p' ->
let sizer = KeySizer k (fmap fst <$> prepSendAnnex k)
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')

View file

@ -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