{-# 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) -> (forall a. [a] -> a
head [b]
x, Char
s)) forall a b. (a -> b) -> a -> b
$ 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
_ [] = forall a. HasCallStack => String -> a
error String
"Attempt to use quantifyNums on an empty list"
quantifyNums SizeOpts
opts (a
headnum:[a]
xs) =
    (forall a b. (a -> b) -> [a] -> [b]
map (\a
n -> forall {a} {p}. (Real p, Floating a) => p -> a
procnum a
n) (a
headnumforall a. a -> [a] -> [a]
:[a]
xs), Char
suffix)
    where number :: Double
number = case forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ a
headnum of
                     Double
0 -> Double
1
                     Double
x -> Double
x
          incrList :: [Int]
incrList = forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
idx2pwr [Int
0..forall (t :: * -> *) a. Foldable t => t a -> Int
length (SizeOpts -> String
suffixes SizeOpts
opts) forall a. Num a => a -> a -> a
- Int
1]
          incrIdxList :: [(Int, Integer)]
incrIdxList = forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
incrList [Integer
0..]
          idx2pwr :: Int -> Int
idx2pwr Int
i = Int
i forall a. Num a => a -> a -> a
* SizeOpts -> Int
powerIncr SizeOpts
opts forall a. Num a => a -> a -> a
+ SizeOpts -> Int
firstPower SizeOpts
opts
          finderfunc :: (a, b) -> Bool
finderfunc (a
x, b
_) = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ SizeOpts -> Int
base SizeOpts
opts) forall a. Floating a => a -> a -> a
** (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
                              forall a. Ord a => a -> a -> Bool
<= (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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall {a} {b}. Integral a => (a, b) -> Bool
finderfunc (forall a. [a] -> [a]
reverse [(Int, Integer)]
incrIdxList) of
                  Just (Int, Integer)
x  -> (Int, Integer)
x
                  Maybe (Int, Integer)
Nothing -> forall a. [a] -> a
head [(Int, Integer)]
incrIdxList -- If not found, it's smaller than the first
          suffix :: Char
suffix = (SizeOpts -> String
suffixes SizeOpts
opts forall a. [a] -> Int -> a
!! (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
expidx))
          procnum :: p -> a
procnum p
n = (forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ p
n) forall a. Fractional a => a -> a -> a
/
                      ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (SizeOpts -> Int
base SizeOpts
opts) forall a. Floating a => a -> a -> 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 =
    (forall r. PrintfType r => String -> r
printf (String
"%." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
prec forall a. [a] -> [a] -> [a]
++ String
"g") Double
num) forall a. [a] -> [a] -> [a]
++ [Char
suffix]
    where (Double
num, Char
suffix) = (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 =
    forall a b. (a -> b) -> [a] -> [b]
map forall {t}. PrintfArg t => t -> String
printit [Double]
convnums
    where printit :: t -> String
printit t
num =
              (forall r. PrintfType r => String -> r
printf (String
"%." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
prec forall a. [a] -> [a] -> [a]
++ String
"f") t
num) forall a. [a] -> [a] -> [a]
++ [Char
suffix]
          ([Double]
convnums, Char
suffix) =
              (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 forall a. Read a => ReadS a
reads String
inp of
      [] -> forall a b. a -> Either a b
Left String
"Couldn't parse numeric component of input"
      [(a
num, String
"")] -> forall a b. b -> Either a b
Right a
num  -- No suffix; pass number unhindered
      [(a
num, [Char
suffix])] ->
          case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Char -> Char
caseTransformer Char
suffix) [(Char, Int)]
suffixMap of
            Maybe Int
Nothing    -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unrecognized suffix " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
suffix
            Just Int
power -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ a
num forall a. Num a => a -> a -> a
* forall a. (Read a, Fractional a) => Int -> a
multiplier Int
power
      [(a
_, String
suffix)] -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Multi-character suffix " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
suffix
      [(a, String)]
_ -> forall a b. a -> Either a b
Left String
"Multiple parses for input"
    where suffixMap :: [(Char, Int)]
suffixMap = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
caseTransformer forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeOpts -> String
suffixes forall a b. (a -> b) -> a -> b
$ SizeOpts
opts)
                          (forall a. (a -> a) -> a -> [a]
iterate (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 =
              forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$
                           forall a b. (Integral a, Num b) => a -> b
fromIntegral (SizeOpts -> Int
base SizeOpts
opts) forall a. Floating a => a -> a -> a
** 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 (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  -> forall a b. a -> Either a b
Left String
x
      Right Double
n -> forall a b. b -> Either a b
Right (forall a b. (RealFrac a, Integral b) => a -> b
round Double
n)