percentage library
This commit is contained in:
parent
d2bfba6324
commit
0c9c14b52f
2 changed files with 40 additions and 6 deletions
|
@ -12,7 +12,6 @@ module Command.Status where
|
||||||
import Control.Monad.State.Strict
|
import Control.Monad.State.Strict
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Text.JSON
|
import Text.JSON
|
||||||
import Data.Ratio
|
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Types.Backend as B
|
import qualified Types.Backend as B
|
||||||
|
@ -31,6 +30,7 @@ import Logs.UUID
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Remote
|
import Remote
|
||||||
import Config
|
import Config
|
||||||
|
import Utility.Percentage
|
||||||
|
|
||||||
-- a named computation that produces a statistic
|
-- a named computation that produces a statistic
|
||||||
type Stat = StatState (Maybe (String, StatState String))
|
type Stat = StatState (Maybe (String, StatState String))
|
||||||
|
@ -161,7 +161,7 @@ bloom_info = stat "bloom filter size" $ json id $ do
|
||||||
let note = aside $
|
let note = aside $
|
||||||
if localkeys >= capacity
|
if localkeys >= capacity
|
||||||
then "appears too small for this repository; adjust annex.bloomcapacity"
|
then "appears too small for this repository; adjust annex.bloomcapacity"
|
||||||
else show (floor (percentage capacity localkeys) :: Integer) ++ "% full"
|
else showPercentage 1 (percentage capacity localkeys) ++ " full"
|
||||||
|
|
||||||
-- Two bloom filters are used at the same time, so double the size
|
-- Two bloom filters are used at the same time, so double the size
|
||||||
-- of one.
|
-- of one.
|
||||||
|
@ -170,10 +170,6 @@ bloom_info = stat "bloom filter size" $ json id $ do
|
||||||
|
|
||||||
return $ size ++ note
|
return $ size ++ note
|
||||||
|
|
||||||
where
|
|
||||||
percentage :: Integer -> Integer -> Double
|
|
||||||
percentage full have = 100 * (fromRational $ have % full)
|
|
||||||
|
|
||||||
disk_size :: Stat
|
disk_size :: Stat
|
||||||
disk_size = stat "available local disk space" $ json id $ lift $
|
disk_size = stat "available local disk space" $ json id $ lift $
|
||||||
calcfree
|
calcfree
|
||||||
|
|
38
Utility/Percentage.hs
Normal file
38
Utility/Percentage.hs
Normal file
|
@ -0,0 +1,38 @@
|
||||||
|
{- percentages
|
||||||
|
-
|
||||||
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Utility.Percentage (
|
||||||
|
Percentage,
|
||||||
|
percentage,
|
||||||
|
showPercentage
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Ratio
|
||||||
|
|
||||||
|
newtype Percentage = Percentage (Ratio Integer)
|
||||||
|
|
||||||
|
instance Show Percentage where
|
||||||
|
show = showPercentage 0
|
||||||
|
|
||||||
|
{- Normally the big number comes first. But 110% is allowed if desired. :) -}
|
||||||
|
percentage :: Integer -> Integer -> Percentage
|
||||||
|
percentage 0 _ = Percentage 0
|
||||||
|
percentage full have = Percentage $ have * 100 % full
|
||||||
|
|
||||||
|
{- Pretty-print a Percentage, with a specified level of precision. -}
|
||||||
|
showPercentage :: Int -> Percentage -> String
|
||||||
|
showPercentage precision (Percentage p)
|
||||||
|
| precision == 0 || remainder == 0 = go $ show int
|
||||||
|
| otherwise = go $ show int ++ "." ++ strip0s (show remainder)
|
||||||
|
where
|
||||||
|
go v = v ++ "%"
|
||||||
|
int :: Integer
|
||||||
|
(int, frac) = properFraction (fromRational p)
|
||||||
|
remainder = floor (frac * multiplier) :: Integer
|
||||||
|
strip0s = reverse . dropWhile (== '0') . reverse
|
||||||
|
multiplier :: Float
|
||||||
|
multiplier = 10 ** (fromIntegral precision)
|
Loading…
Add table
Reference in a new issue