{- data size display and parsing
 -
 - Copyright 2011 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -
 -
 - And now a rant: 
 -
 - In the beginning, we had powers of two, and they were good.
 -
 - Disk drive manufacturers noticed that some powers of two were
 - sorta close to some powers of ten, and that rounding down to the nearest
 - power of ten allowed them to advertise their drives were bigger. This
 - was sorta annoying.
 -
 - Then drives got big. Really, really big. This was good.
 -
 - Except that the small rounding error perpretrated by the drive
 - manufacturers suffered the fate of a small error, and became a large
 - error. This was bad.
 -
 - So, a committee was formed. And it arrived at a committee-like decision,
 - which satisfied noone, confused everyone, and made the world an uglier
 - place. As with all committees, this was meh.
 -
 - And the drive manufacturers happily continued selling drives that are
 - increasingly smaller than you'd expect, if you don't count on your
 - fingers. But that are increasingly too big for anyone to much notice.
 - This caused me to need git-annex.
 -
 - Thus, I use units here that I loathe. Because if I didn't, people would
 - be confused that their drives seem the wrong size, and other people would
 - complain at me for not being standards compliant. And we call this
 - progress?
 -}

module Utility.DataUnits (
	dataUnits,
	storageUnits,
	memoryUnits,
	bandwidthUnits,
	oldSchoolUnits,
	Unit(..),
	ByteSize,

	roughSize,
	roughSize',
	compareSizes,
	readSize
) where

import Data.List
import Data.Char

import Utility.HumanNumber

type ByteSize = Integer
type Name = String
type Abbrev = String
data Unit = Unit ByteSize Abbrev Name
	deriving (Eq Unit
Eq Unit
-> (Unit -> Unit -> Ordering)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Bool)
-> (Unit -> Unit -> Unit)
-> (Unit -> Unit -> Unit)
-> Ord Unit
Unit -> Unit -> Bool
Unit -> Unit -> Ordering
Unit -> Unit -> Unit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Unit -> Unit -> Unit
$cmin :: Unit -> Unit -> Unit
max :: Unit -> Unit -> Unit
$cmax :: Unit -> Unit -> Unit
>= :: Unit -> Unit -> Bool
$c>= :: Unit -> Unit -> Bool
> :: Unit -> Unit -> Bool
$c> :: Unit -> Unit -> Bool
<= :: Unit -> Unit -> Bool
$c<= :: Unit -> Unit -> Bool
< :: Unit -> Unit -> Bool
$c< :: Unit -> Unit -> Bool
compare :: Unit -> Unit -> Ordering
$ccompare :: Unit -> Unit -> Ordering
$cp1Ord :: Eq Unit
Ord, Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
(Int -> Unit -> ShowS)
-> (Unit -> String) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show, Unit -> Unit -> Bool
(Unit -> Unit -> Bool) -> (Unit -> Unit -> Bool) -> Eq Unit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unit -> Unit -> Bool
$c/= :: Unit -> Unit -> Bool
== :: Unit -> Unit -> Bool
$c== :: Unit -> Unit -> Bool
Eq)

dataUnits :: [Unit]
dataUnits :: [Unit]
dataUnits = [Unit]
storageUnits [Unit] -> [Unit] -> [Unit]
forall a. [a] -> [a] -> [a]
++ [Unit]
memoryUnits

{- Storage units are (stupidly) powers of ten. -}
storageUnits :: [Unit]
storageUnits :: [Unit]
storageUnits =
	[ ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
8) String
"YB" String
"yottabyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
7) String
"ZB" String
"zettabyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
6) String
"EB" String
"exabyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
5) String
"PB" String
"petabyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
4) String
"TB" String
"terabyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
3) String
"GB" String
"gigabyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
2) String
"MB" String
"megabyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
1) String
"kB" String
"kilobyte" -- weird capitalization thanks to committe
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
0) String
"B" String
"byte"
	]
  where
	p :: Integer -> Integer
	p :: ByteSize -> ByteSize
p ByteSize
n = ByteSize
1000ByteSize -> ByteSize -> ByteSize
forall a b. (Num a, Integral b) => a -> b -> a
^ByteSize
n

{- Memory units are (stupidly named) powers of 2. -}
memoryUnits :: [Unit]
memoryUnits :: [Unit]
memoryUnits =
	[ ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
8) String
"YiB" String
"yobibyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
7) String
"ZiB" String
"zebibyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
6) String
"EiB" String
"exbibyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
5) String
"PiB" String
"pebibyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
4) String
"TiB" String
"tebibyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
3) String
"GiB" String
"gibibyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
2) String
"MiB" String
"mebibyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
1) String
"KiB" String
"kibibyte"
	, ByteSize -> String -> String -> Unit
Unit (ByteSize -> ByteSize
p ByteSize
0) String
"B" String
"byte"
	]
  where
	p :: Integer -> Integer
	p :: ByteSize -> ByteSize
p ByteSize
n = ByteSize
2ByteSize -> ByteSize -> ByteSize
forall a b. (Num a, Integral b) => a -> b -> a
^(ByteSize
nByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
*ByteSize
10)

{- Bandwidth units are only measured in bits if you're some crazy telco. -}
bandwidthUnits :: [Unit]
bandwidthUnits :: [Unit]
bandwidthUnits = String -> [Unit]
forall a. HasCallStack => String -> a
error String
"stop trying to rip people off"

{- Do you yearn for the days when men were men and megabytes were megabytes? -}
oldSchoolUnits :: [Unit]
oldSchoolUnits :: [Unit]
oldSchoolUnits = (Unit -> Unit -> Unit) -> [Unit] -> [Unit] -> [Unit]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Unit, Unit) -> Unit) -> Unit -> Unit -> Unit
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Unit, Unit) -> Unit
mingle) [Unit]
storageUnits [Unit]
memoryUnits
  where
	mingle :: (Unit, Unit) -> Unit
mingle (Unit ByteSize
_ String
a String
n, Unit ByteSize
s' String
_ String
_) = ByteSize -> String -> String -> Unit
Unit ByteSize
s' String
a String
n

{- approximate display of a particular number of bytes -}
roughSize :: [Unit] -> Bool -> ByteSize -> String
roughSize :: [Unit] -> Bool -> ByteSize -> String
roughSize [Unit]
units Bool
short ByteSize
i = [Unit] -> Bool -> Int -> ByteSize -> String
roughSize' [Unit]
units Bool
short Int
2 ByteSize
i

roughSize' :: [Unit] -> Bool -> Int -> ByteSize -> String
roughSize' :: [Unit] -> Bool -> Int -> ByteSize -> String
roughSize' [Unit]
units Bool
short Int
precision ByteSize
i
	| ByteSize
i ByteSize -> ByteSize -> Bool
forall a. Ord a => a -> a -> Bool
< ByteSize
0 = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: [Unit] -> ByteSize -> String
findUnit [Unit]
units' (ByteSize -> ByteSize
forall a. Num a => a -> a
negate ByteSize
i)
	| Bool
otherwise = [Unit] -> ByteSize -> String
findUnit [Unit]
units' ByteSize
i
  where
	units' :: [Unit]
units' = (Unit -> Unit -> Ordering) -> [Unit] -> [Unit]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Unit -> Unit -> Ordering) -> Unit -> Unit -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Unit -> Unit -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) [Unit]
units -- largest first

	findUnit :: [Unit] -> ByteSize -> String
findUnit (u :: Unit
u@(Unit ByteSize
s String
_ String
_):[Unit]
us) ByteSize
i'
		| ByteSize
i' ByteSize -> ByteSize -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteSize
s = ByteSize -> Unit -> String
showUnit ByteSize
i' Unit
u
		| Bool
otherwise = [Unit] -> ByteSize -> String
findUnit [Unit]
us ByteSize
i'
	findUnit [] ByteSize
i' = ByteSize -> Unit -> String
showUnit ByteSize
i' ([Unit] -> Unit
forall a. [a] -> a
last [Unit]
units') -- bytes

	showUnit :: ByteSize -> Unit -> String
showUnit ByteSize
x (Unit ByteSize
size String
abbrev String
name) = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
unit
	  where
		v :: Double
v = (ByteSize -> Double
forall a. Num a => ByteSize -> a
fromInteger ByteSize
x :: Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ ByteSize -> Double
forall a. Num a => ByteSize -> a
fromInteger ByteSize
size
		s :: String
s = Int -> Double -> String
forall a. RealFrac a => Int -> a -> String
showImprecise Int
precision Double
v
		unit :: String
unit
			| Bool
short = String
abbrev
			| String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1" = String
name
			| Bool
otherwise = String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"s"

{- displays comparison of two sizes -}
compareSizes :: [Unit] -> Bool -> ByteSize -> ByteSize -> String
compareSizes :: [Unit] -> Bool -> ByteSize -> ByteSize -> String
compareSizes [Unit]
units Bool
abbrev ByteSize
old ByteSize
new
	| ByteSize
old ByteSize -> ByteSize -> Bool
forall a. Ord a => a -> a -> Bool
> ByteSize
new = [Unit] -> Bool -> ByteSize -> String
roughSize [Unit]
units Bool
abbrev (ByteSize
old ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
- ByteSize
new) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" smaller"
	| ByteSize
old ByteSize -> ByteSize -> Bool
forall a. Ord a => a -> a -> Bool
< ByteSize
new = [Unit] -> Bool -> ByteSize -> String
roughSize [Unit]
units Bool
abbrev (ByteSize
new ByteSize -> ByteSize -> ByteSize
forall a. Num a => a -> a -> a
- ByteSize
old) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" larger"
	| Bool
otherwise = String
"same"

{- Parses strings like "10 kilobytes" or "0.5tb". -}
readSize :: [Unit] -> String -> Maybe ByteSize
readSize :: [Unit] -> String -> Maybe ByteSize
readSize [Unit]
units String
input
	| [(Double, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Double, String)]
parsednum Bool -> Bool -> Bool
|| [ByteSize] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteSize]
parsedunit = Maybe ByteSize
forall a. Maybe a
Nothing
	| Bool
otherwise = ByteSize -> Maybe ByteSize
forall a. a -> Maybe a
Just (ByteSize -> Maybe ByteSize) -> ByteSize -> Maybe ByteSize
forall a b. (a -> b) -> a -> b
$ Double -> ByteSize
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> ByteSize) -> Double -> ByteSize
forall a b. (a -> b) -> a -> b
$ Double
number Double -> Double -> Double
forall a. Num a => a -> a -> a
* ByteSize -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteSize
multiplier
  where
	(Double
number, String
rest) = [(Double, String)] -> (Double, String)
forall a. [a] -> a
head [(Double, String)]
parsednum
	multiplier :: ByteSize
multiplier = [ByteSize] -> ByteSize
forall a. [a] -> a
head [ByteSize]
parsedunit
	unitname :: String
unitname = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isAlpha ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
rest

	parsednum :: [(Double, String)]
parsednum = ReadS Double
forall a. Read a => ReadS a
reads String
input :: [(Double, String)]
	parsedunit :: [ByteSize]
parsedunit = [Unit] -> String -> [ByteSize]
lookupUnit [Unit]
units String
unitname

	lookupUnit :: [Unit] -> String -> [ByteSize]
lookupUnit [Unit]
_ [] = [ByteSize
1] -- no unit given, assume bytes
	lookupUnit [] String
_ = []
	lookupUnit (Unit ByteSize
s String
a String
n:[Unit]
us) String
v
		| String
a String -> String -> Bool
~~ String
v Bool -> Bool -> Bool
|| String
n String -> String -> Bool
~~ String
v = [ByteSize
s]
		| ShowS
plural String
n String -> String -> Bool
~~ String
v Bool -> Bool -> Bool
|| String
a String -> String -> Bool
~~ ShowS
byteabbrev String
v = [ByteSize
s]
		| Bool
otherwise = [Unit] -> String -> [ByteSize]
lookupUnit [Unit]
us String
v
		
	String
a ~~ :: String -> String -> Bool
~~ String
b = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
b
		
	plural :: ShowS
plural String
n = String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"s"
	byteabbrev :: ShowS
byteabbrev String
a = String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"b"