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:
parent
191bdaafc5
commit
8355dba5cc
18 changed files with 60 additions and 44 deletions
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue