{-|
Module      : Byte Count Reader
Description : Read strings like "2kb" and "12 MiB" as counts of bytes
Copyright   : (c) Daniel Rolls, 2020
License     : GPL-3
Maintainer  : daniel.rolls.27@googlemail.com

This library is for reading strings describing a number of bytes like 2Kb and 0.5 MiB.
-}
module Data.ByteCountReader (sizeInBytes, sizeInBytesAssumingBase2) where

import Data.Char (toLower)
import Data.Either.Extra (eitherToMaybe)
import Data.Text (Text(), unpack)
import GHC.Float.RealFracMethods (roundDoubleInteger)
import Text.ParserCombinators.Parsec.Number (floating3)
import Text.ParserCombinators.Parsec (GenParser, many, many1, oneOf, char, parse, anyChar)

-- |Read strings describing a number of bytes like 2KB and 0.5 MiB.
-- The units KB, MB, GB and TB are assumed to be base 10 (e.g. 2KB = 2 x 1000).
-- The units KiB, MiB, GiB and TiB are assumed to be base 2 (e.g. 2KiB = 2 * 1024).
sizeInBytes :: Text -> Maybe Integer
sizeInBytes :: Text -> Maybe Integer
sizeInBytes Text
inStr = do (Double
number, String
units) <- Either ParseError (Double, String) -> Maybe (Double, String)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either ParseError (Double, String) -> Maybe (Double, String))
-> Either ParseError (Double, String) -> Maybe (Double, String)
forall a b. (a -> b) -> a -> b
$ Parsec String () (Double, String)
-> String -> String -> Either ParseError (Double, String)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (Double, String)
forall st. GenParser Char st (Double, String)
bytesParser String
"<>" (Text -> String
unpack Text
inStr)
                       Double -> Integer
roundDoubleInteger (Double -> Integer) -> (Integer -> Double) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
number Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Integer
toMultiplier String
units

-- |Read strings describing a number of bytes like 2KB and 0.5 MiB assuming 1Kb is 1024 bytes, not 1000.
-- The units KB, MB, GB and TB are assumed to be base 2 (e.g. 2KB = 2 x 1024).
-- The units KiB, MiB, GiB and TiB are assumed to be base 2 (e.g. 2KiB = 2 * 1024).
sizeInBytesAssumingBase2 :: Text -> Maybe Integer
sizeInBytesAssumingBase2 :: Text -> Maybe Integer
sizeInBytesAssumingBase2 Text
inStr = do (Double
number, String
units) <- Either ParseError (Double, String) -> Maybe (Double, String)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either ParseError (Double, String) -> Maybe (Double, String))
-> Either ParseError (Double, String) -> Maybe (Double, String)
forall a b. (a -> b) -> a -> b
$ Parsec String () (Double, String)
-> String -> String -> Either ParseError (Double, String)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (Double, String)
forall st. GenParser Char st (Double, String)
bytesParser String
"<>" (Text -> String
unpack Text
inStr)
                                    Double -> Integer
roundDoubleInteger (Double -> Integer) -> (Integer -> Double) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
number Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Integer
toBase2Multiplier String
units

bytesParser :: GenParser Char st (Double, String)
bytesParser :: GenParser Char st (Double, String)
bytesParser = do Double
num <- CharParser st Double
forall st. CharParser st Double
parseNumber
                 ParsecT String st Identity String
forall u. ParsecT String u Identity String
parseSpaces
                 String
units <- ParsecT String st Identity String
forall u. ParsecT String u Identity String
parseUnits
                 (Double, String) -> GenParser Char st (Double, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
num, String
units)
               where parseSpaces :: ParsecT String u Identity String
parseSpaces = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
                     parseNumber :: CharParser st Double
parseNumber = Bool -> CharParser st Double
forall f st. Floating f => Bool -> CharParser st f
floating3 Bool
False
                     parseUnits :: ParsecT String u Identity String
parseUnits = ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar

toMultiplier :: String -> Maybe Integer
toMultiplier :: String -> Maybe Integer
toMultiplier = String -> Maybe Integer
forall a. (Eq a, IsString a) => a -> Maybe Integer
mapUnits (String -> Maybe Integer)
-> (String -> String) -> String -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
               where mapUnits :: a -> Maybe Integer
mapUnits a
"b"   = Integer -> Maybe Integer
_1024RaisedTo  Integer
0
                     mapUnits a
"kb"  = Integer -> Maybe Integer
_1000RaisedTo  Integer
1
                     mapUnits a
"kib" = Integer -> Maybe Integer
_1024RaisedTo  Integer
1
                     mapUnits a
"mb"  = Integer -> Maybe Integer
_1000RaisedTo  Integer
2
                     mapUnits a
"mib" = Integer -> Maybe Integer
_1024RaisedTo  Integer
2
                     mapUnits a
"gb"  = Integer -> Maybe Integer
_1000RaisedTo  Integer
3
                     mapUnits a
"gib" = Integer -> Maybe Integer
_1024RaisedTo  Integer
3
                     mapUnits a
"tb"  = Integer -> Maybe Integer
_1000RaisedTo  Integer
4
                     mapUnits a
"tib" = Integer -> Maybe Integer
_1024RaisedTo  Integer
4
                     mapUnits a
_     = Maybe Integer
forall a. Maybe a
Nothing
                     _1024RaisedTo :: Integer -> Maybe Integer
_1024RaisedTo = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Integer -> Integer) -> Integer -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
1024 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^)
                     _1000RaisedTo :: Integer -> Maybe Integer
_1000RaisedTo = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Integer -> Integer) -> Integer -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
1000 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^)

toBase2Multiplier :: String -> Maybe Integer
toBase2Multiplier :: String -> Maybe Integer
toBase2Multiplier = String -> Maybe Integer
forall a. (Eq a, IsString a) => a -> Maybe Integer
mapUnits (String -> Maybe Integer)
-> (String -> String) -> String -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
               where mapUnits :: a -> Maybe Integer
mapUnits a
"b"   = Integer -> Maybe Integer
_1024RaisedTo  Integer
0
                     mapUnits a
"kb"  = Integer -> Maybe Integer
_1024RaisedTo  Integer
1
                     mapUnits a
"kib" = Integer -> Maybe Integer
_1024RaisedTo  Integer
1
                     mapUnits a
"mb"  = Integer -> Maybe Integer
_1024RaisedTo  Integer
2
                     mapUnits a
"mib" = Integer -> Maybe Integer
_1024RaisedTo  Integer
2
                     mapUnits a
"gb"  = Integer -> Maybe Integer
_1024RaisedTo  Integer
3
                     mapUnits a
"gib" = Integer -> Maybe Integer
_1024RaisedTo  Integer
3
                     mapUnits a
"tb"  = Integer -> Maybe Integer
_1024RaisedTo  Integer
4
                     mapUnits a
"tib" = Integer -> Maybe Integer
_1024RaisedTo  Integer
4
                     mapUnits a
_     = Maybe Integer
forall a. Maybe a
Nothing
                     _1024RaisedTo :: Integer -> Maybe Integer
_1024RaisedTo = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Integer -> Integer) -> Integer -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
1024 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^)