plumb MeterUpdate into getKey

No behavior changes, but this shows everywhere that a progress meter
could be displayed when hashing a file to add to the annex.

Many of the places don't make sense to display a progress meter though,
eg when importing the copy of the file probably swamps the hashing of
the file.
This commit is contained in:
Joey Hess 2019-06-25 11:37:52 -04:00
parent 191bdaafc5
commit 8355dba5cc
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
18 changed files with 60 additions and 44 deletions

View file

@ -19,6 +19,7 @@ import Types.Key
import Types.Backend
import Types.KeySource
import Utility.Hash
import Utility.Metered
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
@ -86,8 +87,8 @@ hashKeyVariety (Blake2spHash size) he = Blake2spKey size he
#endif
{- A key is a hash of its contents. -}
keyValue :: Hash -> KeySource -> Annex (Maybe Key)
keyValue hash source = do
keyValue :: Hash -> KeySource -> MeterUpdate -> Annex (Maybe Key)
keyValue hash source meterupate = do
let file = contentLocation source
filesize <- liftIO $ getFileSize file
s <- hashFile hash file
@ -98,8 +99,9 @@ keyValue hash source = do
}
{- Extension preserving keys. -}
keyValueE :: Hash -> KeySource -> Annex (Maybe Key)
keyValueE hash source = keyValue hash source >>= maybe (return Nothing) addE
keyValueE :: Hash -> KeySource -> MeterUpdate -> Annex (Maybe Key)
keyValueE hash source meterupdate =
keyValue hash source meterupdate >>= maybe (return Nothing) addE
where
addE k = do
maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig
@ -286,7 +288,7 @@ md5Hasher = show . md5
testKeyBackend :: Backend
testKeyBackend =
let b = genBackendE (SHA2Hash (HashSize 256))
in b { getKey = (fmap addE) <$$> getKey b }
in b { getKey = \ks p -> (fmap addE) <$> getKey b ks p }
where
addE k = k { keyName = keyName k <> longext }
longext = ".this-is-a-test-key"

View file

@ -21,7 +21,7 @@ backends = [backend]
backend :: Backend
backend = Backend
{ backendVariety = URLKey
, getKey = const $ return Nothing
, getKey = \_ _ -> return Nothing
, verifyKeyContent = Nothing
, canUpgradeKey = Nothing
, fastMigrate = Nothing

View file

@ -13,6 +13,7 @@ import Types.Backend
import Types.KeySource
import Backend.Utilities
import Git.FilePath
import Utility.Metered
import qualified Data.ByteString.Char8 as S8
@ -32,8 +33,8 @@ backend = Backend
{- The key includes the file size, modification time, and the
- original filename relative to the top of the git repository.
-}
keyValue :: KeySource -> Annex (Maybe Key)
keyValue source = do
keyValue :: KeySource -> MeterUpdate -> Annex (Maybe Key)
keyValue source _ = do
let f = contentLocation source
stat <- liftIO $ getFileStatus f
sz <- liftIO $ getFileSize' f stat