summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-07-19 19:39:14 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-07-19 19:39:14 -0400
commitd3d9381f09fba70b0d622815b797358c6bcdc548 (patch)
tree38fcd594a788a56fc6f52552346f54f51ad3b2e1
parent284970a49c77e8a410929231906766c538fe9269 (diff)
refactor and unify code
This fixes several bugs in both modules.
-rw-r--r--Utility/DataUnits.hs29
-rw-r--r--Utility/HumanNumber.hs21
-rw-r--r--Utility/Percentage.hs14
3 files changed, 37 insertions, 27 deletions
diff --git a/Utility/DataUnits.hs b/Utility/DataUnits.hs
index 511b3be80..2a936f1fd 100644
--- a/Utility/DataUnits.hs
+++ b/Utility/DataUnits.hs
@@ -50,6 +50,8 @@ module Utility.DataUnits (
import Data.List
import Data.Char
+import Utility.HumanNumber
+
type ByteSize = Integer
type Name = String
type Abbrev = String
@@ -105,7 +107,7 @@ oldSchoolUnits = zipWith (curry mingle) storageUnits memoryUnits
{- approximate display of a particular number of bytes -}
roughSize :: [Unit] -> Bool -> ByteSize -> String
-roughSize units abbrev i
+roughSize units short i
| i < 0 = '-' : findUnit units' (negate i)
| otherwise = findUnit units' i
where
@@ -116,23 +118,14 @@ roughSize units abbrev i
| otherwise = findUnit us i'
findUnit [] i' = showUnit i' (last units') -- bytes
- showUnit i' (Unit s a n) = let (num, decimal) = chop i' s in
- show num ++ decimal ++ " " ++
- (if abbrev then a else plural num decimal n)
-
- chop :: Integer -> Integer -> (Integer, String)
- chop i' d =
- let (num, decimal) = properFraction $ (fromInteger i' :: Double) / fromInteger d
- dnum = round (decimal * 100) :: Integer
- ds = show dnum
- ds' = (take (2 - length ds) (repeat '0')) ++ ds
- in if (dnum == 0)
- then (num, "")
- else (num, "." ++ ds')
-
- plural num decimal n
- | num == 1 && null decimal = n
- | otherwise = n ++ "s"
+ showUnit x (Unit size abbrev name) = s ++ " " ++ unit
+ where
+ v = (fromInteger x :: Double) / fromInteger size
+ s = showImprecise 2 v
+ unit
+ | short = abbrev
+ | s == "1" = name
+ | otherwise = name ++ "s"
{- displays comparison of two sizes -}
compareSizes :: [Unit] -> Bool -> ByteSize -> ByteSize -> String
diff --git a/Utility/HumanNumber.hs b/Utility/HumanNumber.hs
new file mode 100644
index 000000000..904135987
--- /dev/null
+++ b/Utility/HumanNumber.hs
@@ -0,0 +1,21 @@
+{- numbers for humans
+ -
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.HumanNumber where
+
+{- Displays a fractional value as a string with a limited number
+ - of decimal digits. -}
+showImprecise :: RealFrac a => Int -> a -> String
+showImprecise precision n
+ | precision == 0 || remainder == 0 = show (round n :: Integer)
+ | otherwise = show int ++ "." ++ striptrailing0s (pad0s $ show remainder)
+ where
+ int :: Integer
+ (int, frac) = properFraction n
+ remainder = round (frac * 10 ^ precision) :: Integer
+ pad0s s = (take (precision - length s) (repeat '0')) ++ s
+ striptrailing0s = reverse . dropWhile (== '0') . reverse
diff --git a/Utility/Percentage.hs b/Utility/Percentage.hs
index 1c6b50062..8d9280148 100644
--- a/Utility/Percentage.hs
+++ b/Utility/Percentage.hs
@@ -13,6 +13,8 @@ module Utility.Percentage (
import Data.Ratio
+import Utility.HumanNumber
+
newtype Percentage = Percentage (Ratio Integer)
instance Show Percentage where
@@ -25,14 +27,8 @@ 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)
+showPercentage precision (Percentage p) = v ++ "%"
where
- go v = v ++ "%"
- int :: Integer
- (int, frac) = properFraction (fromRational p)
- remainder = floor (frac * multiplier) :: Integer
+ v = showImprecise precision n
+ n = fromRational p :: Double
strip0s = reverse . dropWhile (== '0') . reverse
- multiplier :: Float
- multiplier = 10 ** (fromIntegral precision)