    {- 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 8) "YB" "yottabyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 7) "ZB" "zettabyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 6) "EB" "exabyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 5) "PB" "petabyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 4) "TB" "terabyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 3) "GB" "gigabyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 2) "MB" "megabyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 1) "kB" "kilobyte" -- weird capitalization thanks to committe
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 0) "B" "byte"
    	]
      where
    	p :: Integer -> Integer
    	p :: ByteSize -> ByteSize
    p n :: ByteSize
    n = 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 8) "YiB" "yobibyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 7) "ZiB" "zebibyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 6) "EiB" "exbibyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 5) "PiB" "pebibyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 4) "TiB" "tebibyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 3) "GiB" "gibibyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 2) "MiB" "mebibyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 1) "KiB" "kibibyte"
    	, ByteSize -> String -> String -> Unit
    Unit (ByteSize -> ByteSize
    p 0) "B" "byte"
    	]
      where
    	p :: Integer -> Integer
    	p :: ByteSize -> ByteSize
    p n :: ByteSize
    n = 2ByteSize -> ByteSize -> ByteSize
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(ByteSize
    nByteSize -> ByteSize -> ByteSize
    forall a. Num a => a -> a -> a
    *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 "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 _ a :: String
    a n :: String
    n, Unit s' :: ByteSize
    s' _ _) = 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 units :: [Unit]
    units short :: Bool
    short i :: ByteSize
    i = [Unit] -> Bool -> Int -> ByteSize -> String
    roughSize' [Unit]
    units Bool
    short 2 ByteSize
    i

    roughSize' :: [Unit] -> Bool -> Int -> ByteSize -> String
    roughSize' :: [Unit] -> Bool -> Int -> ByteSize -> String
    roughSize' units :: [Unit]
    units short :: Bool
    short precision :: Int
    precision i :: ByteSize
    i
    	| ByteSize
    i ByteSize -> ByteSize -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 = '-' 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 s :: ByteSize
    s _ _):us :: [Unit]
    us) i' :: 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 [] i' :: ByteSize
    i' = ByteSize -> Unit -> String
    showUnit ByteSize
    i' ([Unit] -> Unit
    forall a. [a] -> a
    last [Unit]
    units') -- bytes

    	showUnit :: ByteSize -> Unit -> String
    showUnit x :: ByteSize
    x (Unit size :: ByteSize
    size abbrev :: String
    abbrev name :: String
    name) = String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " " 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
    == "1" = String
    name
    			| Bool
    otherwise = String
    name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "s"

    {- displays comparison of two sizes -}
    compareSizes :: [Unit] -> Bool -> ByteSize -> ByteSize -> String
    compareSizes :: [Unit] -> Bool -> ByteSize -> ByteSize -> String
    compareSizes units :: [Unit]
    units abbrev :: Bool
    abbrev old :: ByteSize
    old new :: 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]
    ++ " 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]
    ++ " larger"
    	| Bool
    otherwise = "same"

    {- Parses strings like "10 kilobytes" or "0.5tb". -}
    readSize :: [Unit] -> String -> Maybe ByteSize
    readSize :: [Unit] -> String -> Maybe ByteSize
    readSize units :: [Unit]
    units input :: 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
    	(number :: Double
    number, rest :: 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 _ [] = [1] -- no unit given, assume bytes
    	lookupUnit [] _ = []
    	lookupUnit (Unit s :: ByteSize
    s a :: String
    a n :: String
    n:us :: [Unit]
    us) v :: 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

    	a :: String
    a ~~ :: String -> String -> Bool
    ~~ b :: 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 n :: String
    n = String
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "s"
    	byteabbrev :: ShowS
    byteabbrev a :: String
    a = String
    a String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "b"