-- | Here is a quick example:
--
--  > ByteValue (1024 * 1024 * 3) Bytes
--  > -- the above will evaluate to: ByteValue 3145728.0 Bytes
--
--  > getShortHand . getAppropriateUnits $ ByteValue (1024 * 1024 * 3) Bytes
--  > -- the above will evaluate to: "3.00 MB"

module Data.ByteUnits where

import Safe (lastMay)
import Numeric


data ByteUnit = Bytes | KiloBytes | MegaBytes | GigaBytes | TeraBytes | PetaBytes | ExaBytes deriving (Int -> ByteUnit -> ShowS
[ByteUnit] -> ShowS
ByteUnit -> String
(Int -> ByteUnit -> ShowS)
-> (ByteUnit -> String) -> ([ByteUnit] -> ShowS) -> Show ByteUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByteUnit] -> ShowS
$cshowList :: [ByteUnit] -> ShowS
show :: ByteUnit -> String
$cshow :: ByteUnit -> String
showsPrec :: Int -> ByteUnit -> ShowS
$cshowsPrec :: Int -> ByteUnit -> ShowS
Show, ByteUnit -> ByteUnit -> Bool
(ByteUnit -> ByteUnit -> Bool)
-> (ByteUnit -> ByteUnit -> Bool) -> Eq ByteUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteUnit -> ByteUnit -> Bool
$c/= :: ByteUnit -> ByteUnit -> Bool
== :: ByteUnit -> ByteUnit -> Bool
$c== :: ByteUnit -> ByteUnit -> Bool
Eq)

data ByteValue = ByteValue Float ByteUnit deriving (Int -> ByteValue -> ShowS
[ByteValue] -> ShowS
ByteValue -> String
(Int -> ByteValue -> ShowS)
-> (ByteValue -> String)
-> ([ByteValue] -> ShowS)
-> Show ByteValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByteValue] -> ShowS
$cshowList :: [ByteValue] -> ShowS
show :: ByteValue -> String
$cshow :: ByteValue -> String
showsPrec :: Int -> ByteValue -> ShowS
$cshowsPrec :: Int -> ByteValue -> ShowS
Show, ByteValue -> ByteValue -> Bool
(ByteValue -> ByteValue -> Bool)
-> (ByteValue -> ByteValue -> Bool) -> Eq ByteValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteValue -> ByteValue -> Bool
$c/= :: ByteValue -> ByteValue -> Bool
== :: ByteValue -> ByteValue -> Bool
$c== :: ByteValue -> ByteValue -> Bool
Eq)


-- | Also allows comparing sizes, but because it uses float - it might not be 100% accurate
--
-- >>> ByteValue 1024 MegaBytes == ByteValue 1 GigaBytes
-- False
--
-- >>> ByteValue 1023 MegaBytes < ByteValue 1 GigaBytes
-- True
instance Ord ByteValue where
  compare :: ByteValue -> ByteValue -> Ordering
compare ByteValue
a ByteValue
b = Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteValue -> Float
getBytes ByteValue
a) (ByteValue -> Float
getBytes ByteValue
b)

-- | Gets the value of bytes from a ByteValue type
--
getBytes :: ByteValue -> Float
getBytes :: ByteValue -> Float
getBytes (ByteValue Float
v ByteUnit
bu) = case ByteUnit
bu of
  ByteUnit
Bytes -> Float
v
  ByteUnit
KiloBytes -> Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
1)
  ByteUnit
MegaBytes -> Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
2)
  ByteUnit
GigaBytes -> Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
3)
  ByteUnit
TeraBytes -> Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
4)
  ByteUnit
PetaBytes -> Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
5)
  ByteUnit
ExaBytes  -> Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
6)

-- | Converts the ByteValue to an ByteValue with the specified ByteUnit
--
-- >>> convertByteUnit (ByteValue 500 GigaBytes) MegaBytes
-- ByteValue 512000.0 MegaBytes
convertByteUnit :: ByteValue -> ByteUnit -> ByteValue
convertByteUnit :: ByteValue -> ByteUnit -> ByteValue
convertByteUnit ByteValue
bv ByteUnit
bu = case ByteUnit
bu of
  ByteUnit
Bytes -> Float -> ByteUnit -> ByteValue
ByteValue Float
bytes ByteUnit
Bytes
  ByteUnit
KiloBytes -> Float -> ByteUnit -> ByteValue
ByteValue (Float
bytes Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
1)) ByteUnit
KiloBytes
  ByteUnit
MegaBytes -> Float -> ByteUnit -> ByteValue
ByteValue (Float
bytes Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
2)) ByteUnit
MegaBytes
  ByteUnit
GigaBytes -> Float -> ByteUnit -> ByteValue
ByteValue (Float
bytes Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
3)) ByteUnit
GigaBytes
  ByteUnit
TeraBytes -> Float -> ByteUnit -> ByteValue
ByteValue (Float
bytes Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
4)) ByteUnit
TeraBytes
  ByteUnit
PetaBytes -> Float -> ByteUnit -> ByteValue
ByteValue (Float
bytes Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
5)) ByteUnit
PetaBytes
  ByteUnit
ExaBytes  -> Float -> ByteUnit -> ByteValue
ByteValue (Float
bytes Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
1024 Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
6)) ByteUnit
ExaBytes
  where bytes :: Float
bytes = ByteValue -> Float
getBytes ByteValue
bv

-- | Converts to the largest unit size provided the float value is > 1
--
-- >>> getAppropriateUnits (ByteValue 1024 Bytes)
-- ByteValue 1 KiloBytes
--
-- >>> getAppropriateUnits (ByteValue (3.5 * 1024* 1024) Bytes)
-- ByteValue 3.5 MegaBytes
getAppropriateUnits :: ByteValue -> ByteValue
getAppropriateUnits :: ByteValue -> ByteValue
getAppropriateUnits ByteValue
bv = do
  let bUnits :: [ByteUnit]
bUnits = [ByteUnit
Bytes, ByteUnit
KiloBytes, ByteUnit
MegaBytes, ByteUnit
GigaBytes, ByteUnit
TeraBytes, ByteUnit
PetaBytes, ByteUnit
ExaBytes]
  let bytes :: Float
bytes = ByteValue -> Float
getBytes ByteValue
bv
  let units :: [ByteValue]
units = (ByteUnit -> ByteValue) -> [ByteUnit] -> [ByteValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ByteUnit
bu -> ByteValue -> ByteUnit -> ByteValue
convertByteUnit (Float -> ByteUnit -> ByteValue
ByteValue Float
bytes ByteUnit
Bytes) ByteUnit
bu) [ByteUnit]
bUnits
  let appropriateUnits :: [ByteValue]
appropriateUnits = (ByteValue -> Bool) -> [ByteValue] -> [ByteValue]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ByteValue Float
v' ByteUnit
_) -> (Float
v' Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
1.0)) [ByteValue]
units
  case ([ByteValue] -> Maybe ByteValue
forall a. [a] -> Maybe a
lastMay [ByteValue]
appropriateUnits) of
    Just (ByteValue
bv') -> ByteValue
bv'
    Maybe ByteValue
Nothing -> ByteValue
bv

-- | Converts to a short string representation 
--
-- >>> getShortHand $ ByteValue 100 MegaBytes
-- "100.00 MB"
getShortHand :: ByteValue -> String
getShortHand :: ByteValue -> String
getShortHand (ByteValue Float
v ByteUnit
bu) = (Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Float
v) (String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++String
buShort) where
  buShort :: String
buShort = case ByteUnit
bu of
    ByteUnit
Bytes -> String
"B"
    ByteUnit
KiloBytes -> String
"KB"
    ByteUnit
MegaBytes -> String
"MB"
    ByteUnit
GigaBytes -> String
"GB"
    ByteUnit
TeraBytes -> String
"TB"
    ByteUnit
PetaBytes -> String
"PB"
    ByteUnit
ExaBytes -> String
"EB"