add KeyVariety type
Where before the "name" of a key and a backend was a string, this makes it a concrete data type. This is groundwork for allowing some varieties of keys to be disabled in file2key, so git-annex won't use them at all. Benchmarks ran in my big repo: old git-annex info: real 0m3.338s user 0m3.124s sys 0m0.244s new git-annex info: real 0m3.216s user 0m3.024s sys 0m0.220s new git-annex find: real 0m7.138s user 0m6.924s sys 0m0.252s old git-annex find: real 0m7.433s user 0m7.240s sys 0m0.232s Surprising result; I'd have expected it to be slower since it now parses all the key varieties. But, the parser is very simple and perhaps sharing KeyVarieties uses less memory or something like that. This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
parent
ca0daa8bb8
commit
9c4650358c
22 changed files with 202 additions and 99 deletions
|
@ -13,6 +13,7 @@ import qualified Data.Map as M
|
|||
import Command
|
||||
import Annex.Content
|
||||
import Limit
|
||||
import Types.Key
|
||||
import qualified Utility.Format
|
||||
import Utility.DataUnits
|
||||
|
||||
|
@ -76,7 +77,7 @@ showFormatted format unformatted vars =
|
|||
keyVars :: Key -> [(String, String)]
|
||||
keyVars key =
|
||||
[ ("key", key2file key)
|
||||
, ("backend", keyBackendName key)
|
||||
, ("backend", formatKeyVariety $ keyVariety key)
|
||||
, ("bytesize", size show)
|
||||
, ("humansize", size $ roughSize storageUnits True)
|
||||
, ("keyname", keyName key)
|
||||
|
|
|
@ -175,7 +175,7 @@ performRemote key afile backend numcopies remote =
|
|||
|
||||
startKey :: Maybe Remote -> Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
|
||||
startKey from inc key ai numcopies =
|
||||
case Backend.maybeLookupBackendName (keyBackendName key) of
|
||||
case Backend.maybeLookupBackendVariety (keyVariety key) of
|
||||
Nothing -> stop
|
||||
Just backend -> runFsck inc ai key $
|
||||
case from of
|
||||
|
|
|
@ -36,6 +36,7 @@ import qualified Git.LsTree as LsTree
|
|||
import Utility.Percentage
|
||||
import Types.Transfer
|
||||
import Logs.Transfer
|
||||
import Types.Key
|
||||
import Types.TrustLevel
|
||||
import Types.FileMatcher
|
||||
import qualified Limit
|
||||
|
@ -51,7 +52,7 @@ data KeyData = KeyData
|
|||
{ countKeys :: Integer
|
||||
, sizeKeys :: Integer
|
||||
, unknownSizeKeys :: Integer
|
||||
, backendsKeys :: M.Map String Integer
|
||||
, backendsKeys :: M.Map KeyVariety Integer
|
||||
}
|
||||
|
||||
data NumCopiesStats = NumCopiesStats
|
||||
|
@ -451,7 +452,8 @@ disk_size = simpleStat "available local disk space" $
|
|||
|
||||
backend_usage :: Stat
|
||||
backend_usage = stat "backend usage" $ json fmt $
|
||||
ObjectMap . backendsKeys <$> cachedReferencedData
|
||||
ObjectMap . (M.mapKeys formatKeyVariety) . backendsKeys
|
||||
<$> cachedReferencedData
|
||||
where
|
||||
fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . sort . M.toList . fromObjectMap
|
||||
|
||||
|
@ -598,7 +600,7 @@ addKey key (KeyData count size unknownsize backends) =
|
|||
{- All calculations strict to avoid thunks when repeatedly
|
||||
- applied to many keys. -}
|
||||
!count' = count + 1
|
||||
!backends' = M.insertWith (+) (keyBackendName key) 1 backends
|
||||
!backends' = M.insertWith (+) (keyVariety key) 1 backends
|
||||
!size' = maybe size (+ size) ks
|
||||
!unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks
|
||||
ks = keySize key
|
||||
|
|
|
@ -84,7 +84,7 @@ clean file = do
|
|||
-- for this file before, so that when
|
||||
-- git re-cleans a file its backend does
|
||||
-- not change.
|
||||
currbackend <- maybe Nothing (maybeLookupBackendName . keyBackendName)
|
||||
currbackend <- maybe Nothing (maybeLookupBackendVariety . keyVariety)
|
||||
<$> catKeyFile file
|
||||
liftIO . emitPointer
|
||||
=<< go
|
||||
|
|
|
@ -149,7 +149,7 @@ test st r k =
|
|||
Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"
|
||||
present b = check ("present " ++ show b) $
|
||||
(== Right b) <$> Remote.hasKey r k
|
||||
fsck = case maybeLookupBackendName (keyBackendName k) of
|
||||
fsck = case maybeLookupBackendVariety (keyVariety k) of
|
||||
Nothing -> return True
|
||||
Just b -> case Backend.verifyKeyContent b of
|
||||
Nothing -> return True
|
||||
|
|
|
@ -11,6 +11,7 @@ import Command
|
|||
import qualified Build.SysConfig as SysConfig
|
||||
import Annex.Version
|
||||
import BuildFlags
|
||||
import Types.Key
|
||||
import qualified Types.Backend as B
|
||||
import qualified Types.Remote as R
|
||||
import qualified Remote
|
||||
|
@ -62,7 +63,8 @@ showPackageVersion :: IO ()
|
|||
showPackageVersion = do
|
||||
vinfo "git-annex version" SysConfig.packageversion
|
||||
vinfo "build flags" $ unwords buildFlags
|
||||
vinfo "key/value backends" $ unwords $ map B.name Backend.list
|
||||
vinfo "key/value backends" $ unwords $
|
||||
map (formatKeyVariety . B.backendVariety) Backend.list
|
||||
vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes
|
||||
|
||||
showRawVersion :: IO ()
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue