Revert "use vector in local status", which was not an improvement

This reverts commit eb3ce3581a.
This commit is contained in:
Joey Hess 2013-10-07 04:06:10 -04:00
parent eb3ce3581a
commit 6622875cf8
4 changed files with 18 additions and 39 deletions

View file

@ -11,8 +11,6 @@ module Command.Status where
import "mtl" Control.Monad.State.Strict import "mtl" Control.Monad.State.Strict
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Text.JSON import Text.JSON
import Data.Tuple import Data.Tuple
import Data.Ord import Data.Ord
@ -50,23 +48,16 @@ data KeyData = KeyData
} }
data NumCopiesStats = NumCopiesStats data NumCopiesStats = NumCopiesStats
{ numCopiesVariances :: V.Vector Int { numCopiesVarianceMap :: M.Map Variance Integer
} }
{- Since variances can be negative, maxVariance will be newtype Variance = Variance Int
- added to a variance to get its position within the vector. -} deriving (Eq, Ord)
maxVariance :: Int
maxVariance = 1000
toVariance :: Int -> Int instance Show Variance where
toVariance n = n + maxVariance show (Variance n)
| n >= 0 = "numcopies +" ++ show n
showVariance :: Int -> String | otherwise = "numcopies " ++ show n
showVariance v
| n >= 0 = "numcopies +" ++ show n
| otherwise = "numcopies -" ++ show n
where
n = v - maxVariance
-- cached info that multiple Stats use -- cached info that multiple Stats use
data StatInfo = StatInfo data StatInfo = StatInfo
@ -276,14 +267,12 @@ backend_usage = stat "backend usage" $ nojson $
M.unionWith (+) x y M.unionWith (+) x y
numcopies_stats :: Stat numcopies_stats :: Stat
numcopies_stats = stat "numcopies stats" $ nojson $ do numcopies_stats = stat "numcopies stats" $ nojson $
gen . calc . maybe [] (V.toList . numCopiesVariances) calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats)
<$> cachedNumCopiesStats
where where
gen = multiLine calc = multiLine
. map (\(variance, count) -> showVariance variance ++ ": " ++ show count) . map (\(variance, count) -> show variance ++ ": " ++ show count)
. reverse . sortBy (comparing snd) . reverse . sortBy (comparing snd) . M.toList
calc = filter (\(_variance, count) -> count > 0) . zip [0..]
cachedPresentData :: StatState KeyData cachedPresentData :: StatState KeyData
cachedPresentData = do cachedPresentData = do
@ -339,7 +328,7 @@ emptyKeyData :: KeyData
emptyKeyData = KeyData 0 0 0 M.empty emptyKeyData = KeyData 0 0 0 M.empty
emptyNumCopiesStats :: NumCopiesStats emptyNumCopiesStats :: NumCopiesStats
emptyNumCopiesStats = NumCopiesStats $ V.replicate (maxVariance * 2) 0 emptyNumCopiesStats = NumCopiesStats M.empty
foldKeys :: [Key] -> KeyData foldKeys :: [Key] -> KeyData
foldKeys = foldl' (flip addKey) emptyKeyData foldKeys = foldl' (flip addKey) emptyKeyData
@ -357,19 +346,11 @@ addKey key (KeyData count size unknownsize backends) =
ks = keySize key ks = keySize key
updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats
updateNumCopiesStats key file (NumCopiesStats v) = do updateNumCopiesStats key file (NumCopiesStats m) = do
!variance <- toVariance <$> numCopiesCheck file key (-) !variance <- Variance <$> numCopiesCheck file key (-)
let !v' = V.modify (update variance) v let !m' = M.insertWith' (+) variance 1 m
let !ret = NumCopiesStats v' let !ret = NumCopiesStats m'
return ret return ret
where
update variance mv
-- ignore really large variances (extremely unlikely)
| variance < 0 || variance >= maxVariance * 2 = noop
| otherwise = do
n <- MV.read mv variance
let !n' = n+1
MV.write mv variance n'
showSizeKeys :: KeyData -> String showSizeKeys :: KeyData -> String
showSizeKeys d = total ++ missingnote showSizeKeys d = total ++ missingnote

1
debian/control vendored
View file

@ -8,7 +8,6 @@ Build-Depends:
libghc-missingh-dev, libghc-missingh-dev,
libghc-hslogger-dev, libghc-hslogger-dev,
libghc-pcre-light-dev, libghc-pcre-light-dev,
libghc-vector-dev,
libghc-sha-dev, libghc-sha-dev,
libghc-cryptohash-dev, libghc-cryptohash-dev,
libghc-regex-tdfa-dev [!mips !mipsel !s390], libghc-regex-tdfa-dev [!mips !mipsel !s390],

View file

@ -6,7 +6,6 @@ quite a lot.
* [mtl](http://hackage.haskell.org.package/mtl) (2.1.1 or newer) * [mtl](http://hackage.haskell.org.package/mtl) (2.1.1 or newer)
* [MissingH](http://github.com/jgoerzen/missingh/wiki) * [MissingH](http://github.com/jgoerzen/missingh/wiki)
* [utf8-string](http://hackage.haskell.org/package/utf8-string) * [utf8-string](http://hackage.haskell.org/package/utf8-string)
* [vector](http://hackage.haskell.org/package/vector)
* [SHA](http://hackage.haskell.org/package/SHA) * [SHA](http://hackage.haskell.org/package/SHA)
* [cryptohash](http://hackage.haskell.org/package/cryptohash) (optional but recommended) * [cryptohash](http://hackage.haskell.org/package/cryptohash) (optional but recommended)
* [dataenc](http://hackage.haskell.org/package/dataenc) * [dataenc](http://hackage.haskell.org/package/dataenc)

View file

@ -78,7 +78,7 @@ Executable git-annex
Main-Is: git-annex.hs Main-Is: git-annex.hs
Build-Depends: MissingH, hslogger, directory, filepath, Build-Depends: MissingH, hslogger, directory, filepath,
containers, utf8-string, network (>= 2.0), mtl (>= 2), containers, utf8-string, network (>= 2.0), mtl (>= 2),
bytestring, old-locale, time, HTTP, vector, bytestring, old-locale, time, HTTP,
extensible-exceptions, dataenc, SHA, process, json, extensible-exceptions, dataenc, SHA, process, json,
base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers, base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers,
IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process, IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,