use vector in local status

Thought was that this would be faster than a map, since a vector can be
updated more efficiently. It turns out to not seem to matter; runtime and
memory usage are basically identical.

4 files changed, 39 insertions, 18 deletions

diff --git a/Command/Status.hs b/Command/Status.hs
index e9df79eb3..d1f51c067 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -11,6 +11,8 @@ module Command.Status where
 
 import "mtl" Control.Monad.State.Strict
 import qualified Data.Map as M
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as MV
 import Text.JSON
 import Data.Tuple
 import Data.Ord
@@ -48,16 +50,23 @@ data KeyData = KeyData
 	}
 
 data NumCopiesStats = NumCopiesStats
-	{ numCopiesVarianceMap :: M.Map Variance Integer
+	{ numCopiesVariances :: V.Vector Int
 	}
 
-newtype Variance = Variance Int
-	deriving (Eq, Ord)
+{- Since variances can be negative, maxVariance will be
+ - added to a variance to get its position within the vector. -}
+maxVariance :: Int
+maxVariance = 1000
 
-instance Show Variance where
-	show (Variance n)
-		| n >= 0 = "numcopies +" ++ show n
-		| otherwise = "numcopies " ++ show n
+toVariance :: Int -> Int
+toVariance n = n + maxVariance
+
+showVariance :: Int -> String
+showVariance v
+	| n >= 0 = "numcopies +" ++ show n
+	| otherwise = "numcopies -" ++ show n
+  where
+  	n = v - maxVariance
 
 -- cached info that multiple Stats use
 data StatInfo = StatInfo
@@ -267,12 +276,14 @@ backend_usage = stat "backend usage" $ nojson $
 		M.unionWith (+) x y
 
 numcopies_stats :: Stat
-numcopies_stats = stat "numcopies stats" $ nojson $
-	calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats)
+numcopies_stats = stat "numcopies stats" $ nojson $ do
+	gen . calc . maybe [] (V.toList . numCopiesVariances)
+		<$> cachedNumCopiesStats
   where
-	calc = multiLine
-		. map (\(variance, count) -> show variance ++ ": " ++ show count)
-		. reverse . sortBy (comparing snd) . M.toList
+	gen = multiLine
+		. map (\(variance, count) -> showVariance variance ++ ": " ++ show count)
+		. reverse . sortBy (comparing snd)
+	calc = filter (\(_variance, count) -> count > 0) . zip [0..]
 
 cachedPresentData :: StatState KeyData
 cachedPresentData = do
@@ -328,7 +339,7 @@ emptyKeyData :: KeyData
 emptyKeyData = KeyData 0 0 0 M.empty
 
 emptyNumCopiesStats :: NumCopiesStats
-emptyNumCopiesStats = NumCopiesStats M.empty
+emptyNumCopiesStats = NumCopiesStats $ V.replicate (maxVariance * 2) 0
 
 foldKeys :: [Key] -> KeyData
 foldKeys = foldl' (flip addKey) emptyKeyData
@@ -346,11 +357,19 @@ addKey key (KeyData count size unknownsize backends) =
 	ks = keySize key
 
 updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats
-updateNumCopiesStats key file (NumCopiesStats m) = do
-	!variance <- Variance <$> numCopiesCheck file key (-)
-	let !m' = M.insertWith' (+) variance 1 m
-	let !ret = NumCopiesStats m'
+updateNumCopiesStats key file (NumCopiesStats v) = do
+	!variance <- toVariance <$> numCopiesCheck file key (-)
+	let !v' = V.modify (update variance) v
+	let !ret = NumCopiesStats v'
 	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 d = total ++ missingnote
diff --git a/debian/control b/debian/control
index 911974604..f89b6ff58 100644
--- a/debian/control
+++ b/debian/control
@@ -8,6 +8,7 @@ Build-Depends:
 	libghc-missingh-dev,
 	libghc-hslogger-dev,
 	libghc-pcre-light-dev,
+	libghc-vector-dev,
 	libghc-sha-dev,
 	libghc-cryptohash-dev,
 	libghc-regex-tdfa-dev [!mips !mipsel !s390],
diff --git a/doc/install/fromscratch.mdwn b/doc/install/fromscratch.mdwn
index c85de7ef0..62fb75403 100644
--- a/doc/install/fromscratch.mdwn
+++ b/doc/install/fromscratch.mdwn
@@ -6,6 +6,7 @@ quite a lot.
   * [mtl](http://hackage.haskell.org.package/mtl) (2.1.1 or newer)
   * [MissingH](http://github.com/jgoerzen/missingh/wiki)
   * [utf8-string](http://hackage.haskell.org/package/utf8-string)
+  * [vector](http://hackage.haskell.org/package/vector)
   * [SHA](http://hackage.haskell.org/package/SHA)
   * [cryptohash](http://hackage.haskell.org/package/cryptohash) (optional but recommended)
   * [dataenc](http://hackage.haskell.org/package/dataenc)
diff --git a/git-annex.cabal b/git-annex.cabal
index 20ac48511..c8dc4bb9b 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -78,7 +78,7 @@ Executable git-annex
   Main-Is: git-annex.hs
   Build-Depends: MissingH, hslogger, directory, filepath,
    containers, utf8-string, network (>= 2.0), mtl (>= 2),
-   bytestring, old-locale, time, HTTP,
+   bytestring, old-locale, time, HTTP, vector,
    extensible-exceptions, dataenc, SHA, process, json,
    base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers,
    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,