    {-# LANGUAGE Safe #-}
    {-
    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  : provisional
       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           Data.Char
    import           Data.List
    import           Text.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 :: Int -> Int -> Int -> String -> SizeOpts
    SizeOpts {base :: Int
    base = 2,
                           firstPower :: Int
    firstPower = 0,
                           suffixes :: String
    suffixes = " KMGTPEZY",
                           powerIncr :: Int
    powerIncr = 10}

    {- | Predefined definitions for SI measurement, from 10**-24 to 10**24. -}
    siOpts :: SizeOpts
    siOpts :: SizeOpts
    siOpts = SizeOpts :: Int -> Int -> Int -> String -> SizeOpts
    SizeOpts {base :: Int
    base = 10,
                       firstPower :: Int
    firstPower = -24,
                       suffixes :: String
    suffixes = "yzafpnum kMGTPEZY",
                       powerIncr :: Int
    powerIncr = 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 :: SizeOpts -> a -> (b, Char)
    quantifyNum opts :: SizeOpts
    opts n :: a
    n = (\(x :: [b]
    x, s :: Char
    s) -> ([b] -> b
    forall a. [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 :: SizeOpts -> [a] -> ([b], Char)
    quantifyNums _ [] = String -> ([b], Char)
    forall a. HasCallStack => String -> a
    error "Attempt to use quantifyNums on an empty list"
    quantifyNums opts :: SizeOpts
    opts (headnum :: a
    headnum:xs :: [a]
    xs) =
        ((a -> b) -> [a] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map (\n :: a
    n -> a -> b
    forall a a. (Real a, Floating a) => a -> 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
                         0 -> 1
                         x :: Double
    x -> Double
    x
              incrList :: [Int]
    incrList = (Int -> Int) -> [Int] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Int
    idx2pwr [0..String -> 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
    - 1]
              incrIdxList :: [(Int, Integer)]
    incrIdxList = [Int] -> [Integer] -> [(Int, Integer)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int]
    incrList [0..]
              idx2pwr :: Int -> Int
    idx2pwr i :: 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 (x :: a
    x, _) = (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.

              (usedexp :: Int
    usedexp, expidx :: 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 x :: (Int, Integer)
    x  -> (Int, Integer)
    x
                      Nothing -> [(Int, Integer)] -> (Int, Integer)
    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 String -> Int -> Char
    forall a. [a] -> Int -> a
    !! (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    expidx))
              procnum :: a -> a
    procnum n :: a
    n = (Rational -> a
    forall a. Fractional a => Rational -> a
    fromRational (Rational -> a) -> (a -> Rational) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Rational
    forall a. Real a => a -> Rational
    toRational (a -> a) -> a -> a
    forall a b. (a -> b) -> a -> b
    $ a
    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 :: SizeOpts -> Int -> a -> String
    renderNum opts :: SizeOpts
    opts prec :: Int
    prec number :: a
    number =
        (String -> Double -> String
    forall r. PrintfType r => String -> r
    printf ("%." 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]
    ++ "g") Double
    num) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    suffix]
        where (num :: Double
    num, suffix :: 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 :: SizeOpts -> Int -> [a] -> [String]
    renderNums opts :: SizeOpts
    opts prec :: Int
    prec numbers :: [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 num :: t
    num =
                  (String -> t -> String
    forall r. PrintfType r => String -> r
    printf ("%." 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]
    ++ "f") t
    num) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    suffix]
              (convnums :: [Double]
    convnums, suffix :: 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 :: SizeOpts -> Bool -> String -> Either String a
    parseNum opts :: SizeOpts
    opts insensitive :: Bool
    insensitive inp :: 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 "Couldn't parse numeric component of input"
          [(num :: a
    num, "")] -> a -> Either String a
    forall a b. b -> Either a b
    Right a
    num  -- No suffix; pass number unhindered
          [(num :: a
    num, [suffix :: 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
                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
    $ "Unrecognized suffix " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char -> String
    forall a. Show a => a -> String
    show Char
    suffix
                Just power :: 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
          [(_, suffix :: 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
    $ "Multi-character suffix " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    suffix
          _ -> String -> Either String a
    forall a b. a -> Either a b
    Left "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 x :: Char
    x
                  | Bool
    insensitive = Char -> Char
    toLower Char
    x
                  | Bool
    otherwise = Char
    x
              multiplier :: (Read a, Fractional a) => Int -> a
              multiplier :: Int -> a
    multiplier power :: 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 :: SizeOpts -> Bool -> String -> Either String a
    parseNumInt opts :: SizeOpts
    opts insensitive :: Bool
    insensitive inp :: 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 x :: String
    x  -> String -> Either String a
    forall a b. a -> Either a b
    Left String
    x
          Right n :: Double
    n -> a -> Either String a
    forall a b. b -> Either a b
    Right (Double -> a
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    n)