pull out pure code

This commit is contained in:
Joey Hess 2011-09-20 20:18:43 -04:00
parent 98fbeba0df
commit 9d26192350

View file

@ -94,11 +94,11 @@ supported_remote_types = stat "supported remote types" $
local_annex_size :: Stat local_annex_size :: Stat
local_annex_size = stat "local annex size" $ local_annex_size = stat "local annex size" $
cachedKeysPresent >>= keySizeSum cachedKeysPresent >>= return . keySizeSum
total_annex_size :: Stat total_annex_size :: Stat
total_annex_size = stat "total annex size" $ total_annex_size = stat "total annex size" $
cachedKeysReferenced >>= keySizeSum cachedKeysReferenced >>= return . keySizeSum
local_annex_keys :: Stat local_annex_keys :: Stat
local_annex_keys = stat "local annex keys" $ local_annex_keys = stat "local annex keys" $
@ -145,15 +145,17 @@ cachedKeysReferenced = do
put s { keysReferencedCache = Just keys } put s { keysReferencedCache = Just keys }
return keys return keys
keySizeSum :: Set Key -> StatState String keySizeSum :: Set Key -> String
keySizeSum s = do keySizeSum s = total ++ missingnote
let knownsizes = mapMaybe keySize $ S.toList s where
let total = roughSize storageUnits False $ sum knownsizes knownsizes = mapMaybe keySize $ S.toList s
let missing = S.size s - genericLength knownsizes total = roughSize storageUnits False $ sum knownsizes
return $ total ++ missing = S.size s - genericLength knownsizes
if missing == 0 missingnote
then "" | missing == 0 = ""
else aside $ "but " ++ show missing ++ " keys have unknown size" | otherwise = aside $
"but " ++ show missing ++
" keys have unknown size"
staleSize :: String -> (Git.Repo -> FilePath) -> Stat staleSize :: String -> (Git.Repo -> FilePath) -> Stat
staleSize label dirspec = do staleSize label dirspec = do
@ -161,7 +163,7 @@ staleSize label dirspec = do
if null keys if null keys
then nostat then nostat
else stat label $ do else stat label $ do
s <- keySizeSum $ S.fromList keys let s = keySizeSum $ S.fromList keys
return $ s ++ aside "clean up with git-annex unused" return $ s ++ aside "clean up with git-annex unused"
aside :: String -> String aside :: String -> String