{-# LANGUAGE Safe #-}

{-# OPTIONS_GHC -fno-warn-type-defaults #-}
{-
Copyright (c) 2006-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : Data.Quantity
   Copyright  : Copyright (C) 2006-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

Tools for rendering sizes

Written by John Goerzen, jgoerzen\@complete.org -}

module Data.Quantity (
                          renderNum,
                          renderNums,
                          parseNum,
                          parseNumInt,
                          quantifyNum,
                          quantifyNums,
                          SizeOpts(..),
                          binaryOpts,
                          siOpts
                     )

where
import safe Data.Char ( toLower )
import safe Data.List (find)
import safe Text.Printf ( printf )

{- | The options for 'quantifyNum' and 'renderNum' -}
data SizeOpts = SizeOpts { SizeOpts -> Int
base       :: Int, -- ^ The base from which calculations are made
                           SizeOpts -> Int
powerIncr  :: Int, -- ^ The increment to the power for each new suffix
                           SizeOpts -> Int
firstPower :: Int, -- ^ The first power for which suffixes are given
                           SizeOpts -> String
suffixes   :: String -- ^ The suffixes themselves
                         }

{- | Predefined definitions for byte measurement in groups of 1024, from 0 to
2**80 -}
binaryOpts :: SizeOpts
binaryOpts :: SizeOpts
binaryOpts = SizeOpts {base :: Int
base = Int
2,
                       firstPower :: Int
firstPower = Int
0,
                       suffixes :: String
suffixes = String
" KMGTPEZY",
                       powerIncr :: Int
powerIncr = Int
10}

{- | Predefined definitions for SI measurement, from 10**-24 to 10**24. -}
siOpts :: SizeOpts
siOpts :: SizeOpts
siOpts = SizeOpts {base :: Int
base = Int
10,
                   firstPower :: Int
firstPower = -Int
24,
                   suffixes :: String
suffixes = String
"yzafpnum kMGTPEZY",
                   powerIncr :: Int
powerIncr = Int
3}

{- | Takes a number and returns a new (quantity, suffix) combination.
The space character is used as the suffix for items around 0. -}
quantifyNum :: (Ord a, Real a, Floating b, Ord b) => SizeOpts -> a -> (b, Char)
quantifyNum :: forall a b.
(Ord a, Real a, Floating b, Ord b) =>
SizeOpts -> a -> (b, Char)
quantifyNum SizeOpts
opts a
n = (\([b]
x, Char
s) -> ([b] -> b
forall a. HasCallStack => [a] -> a
head [b]
x, Char
s)) (([b], Char) -> (b, Char)) -> ([b], Char) -> (b, Char)
forall a b. (a -> b) -> a -> b
$ SizeOpts -> [a] -> ([b], Char)
forall a b.
(Ord a, Real a, Floating b, Ord b) =>
SizeOpts -> [a] -> ([b], Char)
quantifyNums SizeOpts
opts [a
n]

{- | Like 'quantifyNum', but takes a list of numbers.  The first number in
the list will be evaluated for the suffix.  The same suffix and scale will
be used for the remaining items in the list.  Please see 'renderNums' for
an example of how this works.

It is invalid to use this function on an empty list. -}
quantifyNums :: (Ord a, Real a, Floating b, Ord b) => SizeOpts -> [a] -> ([b], Char)
quantifyNums :: forall a b.
(Ord a, Real a, Floating b, Ord b) =>
SizeOpts -> [a] -> ([b], Char)
quantifyNums SizeOpts
_ [] = String -> ([b], Char)
forall a. HasCallStack => String -> a
error String
"Attempt to use quantifyNums on an empty list"
quantifyNums SizeOpts
opts (a
headnum:[a]
xs) =
    ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\a
n -> a -> b
forall {a} {p}. (Real p, Floating a) => p -> a
procnum a
n) (a
headnuma -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs), Char
suffix)
    where number :: Double
number = case Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> (a -> Rational) -> a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rational
forall a. Real a => a -> Rational
toRational (a -> Double) -> a -> Double
forall a b. (a -> b) -> a -> b
$ a
headnum of
                     Double
0 -> Double
1
                     Double
x -> Double
x
          incrList :: [Int]
incrList = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
idx2pwr [Int
0..String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SizeOpts -> String
suffixes SizeOpts
opts) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
          incrIdxList :: [(Int, Integer)]
incrIdxList = [Int] -> [Integer] -> [(Int, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
incrList [Integer
0..]
          idx2pwr :: Int -> Int
idx2pwr Int
i = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SizeOpts -> Int
powerIncr SizeOpts
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SizeOpts -> Int
firstPower SizeOpts
opts
          finderfunc :: (a, b) -> Bool
finderfunc (a
x, b
_) = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ SizeOpts -> Int
base SizeOpts
opts) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
                              Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= (Double -> Double
forall a. Num a => a -> a
abs Double
number)
          -- Find the largest item that does not exceed the number given.
          -- If the number is larger than the larger item in the list,
          -- that's fine; we'll just write it in terms of what we have.

          (Int
usedexp, Integer
expidx) =
              case ((Int, Integer) -> Bool)
-> [(Int, Integer)] -> Maybe (Int, Integer)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int, Integer) -> Bool
forall {a} {b}. Integral a => (a, b) -> Bool
finderfunc ([(Int, Integer)] -> [(Int, Integer)]
forall a. [a] -> [a]
reverse [(Int, Integer)]
incrIdxList) of
                  Just (Int, Integer)
x  -> (Int, Integer)
x
                  Maybe (Int, Integer)
Nothing -> [(Int, Integer)] -> (Int, Integer)
forall a. HasCallStack => [a] -> a
head [(Int, Integer)]
incrIdxList -- If not found, it's smaller than the first
          suffix :: Char
suffix = (SizeOpts -> String
suffixes SizeOpts
opts String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
expidx))
          procnum :: p -> a
procnum p
n = (Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> (p -> Rational) -> p -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Rational
forall a. Real a => a -> Rational
toRational (p -> a) -> p -> a
forall a b. (a -> b) -> a -> b
$ p
n) a -> a -> a
forall a. Fractional a => a -> a -> a
/
                      ((Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SizeOpts -> Int
base SizeOpts
opts) a -> a -> a
forall a. Floating a => a -> a -> a
** (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
usedexp)))
          --(posres, possuf) = quantifyNum opts (headnum * (-1))

{- | Render a number into a string, based on the given quantities.  This is
useful for displaying quantities in terms of bytes or in SI units.  Give this
function the 'SizeOpts' for the desired output, and a precision (number of
digits to the right of the decimal point), and you get a string output.

Here are some examples:

> Data.Quantity> renderNum binaryOpts 0 1048576
> "1M"
> Data.Quantity> renderNum binaryOpts 2 10485760
> "10.00M"
> Data.Quantity> renderNum binaryOpts 3 1048576
> "1.000M"
> Data.Quantity> renderNum binaryOpts 3 1500000
> "1.431M"
> Data.Quantity> renderNum binaryOpts 2 (1500 ** 3)
> "3.14G"

> Data.Quantity> renderNum siOpts 2 1024
> "1.02k"
> Data.Quantity> renderNum siOpts 2 1048576
> "1.05M"
> Data.Quantity> renderNum siOpts 2 0.001
> "1.00m"
> Data.Quantity> renderNum siOpts 2 0.0001
> "100.00u"

If you want more control over the output, see 'quantifyNum'. -}
renderNum :: (Ord a, Real a) =>
             SizeOpts
          -> Int                -- ^ Precision of the result
          -> a                  -- ^ The number to examine
          -> String
renderNum :: forall a. (Ord a, Real a) => SizeOpts -> Int -> a -> String
renderNum SizeOpts
opts Int
prec a
number =
    (String -> Double -> String
forall r. PrintfType r => String -> r
printf (String
"%." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
prec String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"g") Double
num) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
suffix]
    where (Double
num, Char
suffix) = (SizeOpts -> a -> (Double, Char)
forall a b.
(Ord a, Real a, Floating b, Ord b) =>
SizeOpts -> a -> (b, Char)
quantifyNum SizeOpts
opts a
number)::(Double, Char)

{- | Like 'renderNum', but operates on a list of numbers.  The first number
in the list will be evaluated for the suffix.  The same suffix and scale will
be used for the remaining items in the list.  See 'renderNum' for more
examples.

Also, unlike 'renderNum', the %f instead of %g printf format is used so that
\"scientific\" notation is avoided in the output.

Examples:

> *Data.Quantity> renderNums binaryOpts 3 [1500000, 10240, 104857600]
> ["1.431M","0.010M","100.000M"]
> *Data.Quantity> renderNums binaryOpts 3 [1500, 10240, 104857600]
> ["1.465K","10.000K","102400.000K"]

-}
renderNums :: (Ord a, Real a) =>
              SizeOpts
           -> Int               -- ^ Prevision of the result
           -> [a]               -- ^ The numbers to examine
           -> [String]          -- ^ Result
renderNums :: forall a. (Ord a, Real a) => SizeOpts -> Int -> [a] -> [String]
renderNums SizeOpts
opts Int
prec [a]
numbers =
    (Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Double -> String
forall {t}. PrintfArg t => t -> String
printit [Double]
convnums
    where printit :: t -> String
printit t
num =
              (String -> t -> String
forall r. PrintfType r => String -> r
printf (String
"%." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
prec String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"f") t
num) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
suffix]
          ([Double]
convnums, Char
suffix) =
              (SizeOpts -> [a] -> ([Double], Char)
forall a b.
(Ord a, Real a, Floating b, Ord b) =>
SizeOpts -> [a] -> ([b], Char)
quantifyNums SizeOpts
opts [a]
numbers)::([Double], Char)

{- | Parses a String, possibly generated by 'renderNum'.  Parses the suffix
and applies it to the number, which is read via the Read class.

Returns Left "error message" on error, or Right number on successful parse.

If you want an Integral result, the convenience function 'parseNumInt' is for
you.
-}
parseNum :: (Read a, Fractional a) =>
            SizeOpts            -- ^ Information on how to parse this data
         -> Bool                -- ^ Whether to perform a case-insensitive match
         -> String              -- ^ The string to parse
         -> Either String a
parseNum :: forall a.
(Read a, Fractional a) =>
SizeOpts -> Bool -> String -> Either String a
parseNum SizeOpts
opts Bool
insensitive String
inp =
    case ReadS a
forall a. Read a => ReadS a
reads String
inp of
      [] -> String -> Either String a
forall a b. a -> Either a b
Left String
"Couldn't parse numeric component of input"
      [(a
num, String
"")] -> a -> Either String a
forall a b. b -> Either a b
Right a
num  -- No suffix; pass number unhindered
      [(a
num, [Char
suffix])] ->
          case Char -> [(Char, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Char -> Char
caseTransformer Char
suffix) [(Char, Int)]
suffixMap of
            Maybe Int
Nothing    -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized suffix " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
suffix
            Just Int
power -> a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ a
num a -> a -> a
forall a. Num a => a -> a -> a
* Int -> a
forall a. (Read a, Fractional a) => Int -> a
multiplier Int
power
      [(a
_, String
suffix)] -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Multi-character suffix " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
suffix
      [(a, String)]
_ -> String -> Either String a
forall a b. a -> Either a b
Left String
"Multiple parses for input"
    where suffixMap :: [(Char, Int)]
suffixMap = String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
caseTransformer (String -> String) -> (SizeOpts -> String) -> SizeOpts -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeOpts -> String
suffixes (SizeOpts -> String) -> SizeOpts -> String
forall a b. (a -> b) -> a -> b
$ SizeOpts
opts)
                          ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (SizeOpts -> Int
powerIncr SizeOpts
opts)) (SizeOpts -> Int
firstPower SizeOpts
opts))
          caseTransformer :: Char -> Char
caseTransformer Char
x
              | Bool
insensitive = Char -> Char
toLower Char
x
              | Bool
otherwise = Char
x
          multiplier :: (Read a, Fractional a) => Int -> a
          multiplier :: forall a. (Read a, Fractional a) => Int -> a
multiplier Int
power =
              Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> (Double -> Rational) -> Double -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$
                           Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SizeOpts -> Int
base SizeOpts
opts) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
power
{- | Parse a number as with 'parseNum', but return the result as
an 'Integral'.  Any type such as Integer, Int, etc. can be used for the
result type.

This function simply calls 'round' on the result of 'parseNum'.  A
'Double' is used internally for the parsing of the numeric component.

By using this function, a user can still say something like 1.5M and get an
integral result. -}
parseNumInt :: (Read a, Integral a) =>
               SizeOpts         -- ^ Information on how to parse this data
            -> Bool             -- ^ Whether to perform a case-insensitive match
            -> String           -- ^ The string to parse
            -> Either String a
parseNumInt :: forall a.
(Read a, Integral a) =>
SizeOpts -> Bool -> String -> Either String a
parseNumInt SizeOpts
opts Bool
insensitive String
inp =
    case (SizeOpts -> Bool -> String -> Either String Double
forall a.
(Read a, Fractional a) =>
SizeOpts -> Bool -> String -> Either String a
parseNum SizeOpts
opts Bool
insensitive String
inp)::Either String Double of
      Left String
x  -> String -> Either String a
forall a b. a -> Either a b
Left String
x
      Right Double
n -> a -> Either String a
forall a b. b -> Either a b
Right (Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
n)