{-

Copyright 2012, 2014, 2015, Google Inc.
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
    * Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following disclaimer
in the documentation and/or other materials provided with the
distribution.
    * Neither the name of Google Inc. nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-}

{- | Definitions and functions for parsing and formatting prefix units.

This module defines the type 'Unit' and associated functions for
parsing numbers containing a prefix unit (e.g. @100M@) into
corespondingly scaled values (for the above example, @100000000@), and
for formatting numbers.

The units definition is taken from the man page @units(7)@ and the web
sites <http://physics.nist.gov/cuu/Units/prefixes.html> and
<http://physics.nist.gov/cuu/Units/binary.html>.

Since a give prefix unit (e.g. @m@) can be interpreted in different
ways, the module offers various ways to interpret this:

* in a binary context (e.g. when talking about memory), this will be
  interpreted as 2^20 (see 'ParseBinary')

* in a SI context dealing with multiples, this will be intepreted as
  10^3 (see 'ParseKMGT')

* in an exact parsing mode, this will be interpreded as the \"milli\"
  prefix, i.e. 10^-3 (see 'ParseExact')

The different parsing mode are offered as different contexts will have
different \"natural\" units, and always forcing precise parsing (which
also implies case-sensitivity) will lead to confusing user interfaces.

The internal calculations when converting values are done via the
'Rational' type (with arbitrary precision), and precision loss happens
only at the last step of converting to the target type; for
float\/doubles this is 'fromRational', for integral types this is
'round'.

A few examples are given below:

>>> showValue FormatBinary 2048
"2.0Ki"
>>> showValue FormatSiAll 0.0001
"100.0u"
>>> showValue (FormatFixed Mebi) 1048576
"1Mi"
>>> parseValue ParseExact "2.5Ki"::Either String Double
Right 2560.0
>>> parseValue ParseBinary "2M"::Either String Int
Right 2097152
>>> parseValue ParseExact "2ki"
Left "Unrecognised unit 'ki'"

The failure in the last example is due to the fact that 'ParseExact'
is case-sensitive.

-}

module Data.Prefix.Units
  (
  -- * Basic definitions
  -- ** Types
  Unit(..)
  , RationalConvertible(..)
  , siUnits
  , siSupraunitary
  , siKMGT
  , binaryUnits
  , siBase
  , binaryBase
  -- ** Unit-related functions
  , unitMultiplier
  , unitName
  , unitSymbol
  , fancySymbol
  -- * Formatting functions
  , FormatMode(..)
  , recommendedUnit
  , formatValue
  , showValue
  -- * Parsing functions
  , ParseMode(..)
  , parseSymbol
  , parseValue
  -- * Low-level generic functions
  , unitRange
  -- ** Parsing
  , ParseOptions(..)
  , parseExactSymbol
  , parseBinarySymbol
  , parseKMGTSymbol
  , parseGeneric
  -- ** Formatting
  , showValueWith
  ) where

import Control.Monad (liftM)
import Data.Char (toUpper)
import Data.List (intercalate)

import Data.Prefix.Units.Compat ()

default ()

-- | The unit type.
data Unit = Quecto
          | Ronto
          | Yocto
          | Zepto
          | Atto
          | Femto
          | Pico
          | Nano
          | Micro
          | Milli
          | Centi
          | Deci
          | Deka
          | Hecto
          | Kilo
          | Kibi
          | Mega
          | Mebi
          | Giga
          | Gibi
          | Tera
          | Tebi
          | Peta
          | Pebi
          | Exa
          | Exbi
          | Zetta
          | Yotta
          | Ronna
          | Quetta
            deriving (Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show, Unit -> Unit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unit -> Unit -> Bool
$c/= :: Unit -> Unit -> Bool
== :: Unit -> Unit -> Bool
$c== :: Unit -> Unit -> Bool
Eq, Int -> Unit
Unit -> Int
Unit -> [Unit]
Unit -> Unit
Unit -> Unit -> [Unit]
Unit -> Unit -> Unit -> [Unit]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Unit -> Unit -> Unit -> [Unit]
$cenumFromThenTo :: Unit -> Unit -> Unit -> [Unit]
enumFromTo :: Unit -> Unit -> [Unit]
$cenumFromTo :: Unit -> Unit -> [Unit]
enumFromThen :: Unit -> Unit -> [Unit]
$cenumFromThen :: Unit -> Unit -> [Unit]
enumFrom :: Unit -> [Unit]
$cenumFrom :: Unit -> [Unit]
fromEnum :: Unit -> Int
$cfromEnum :: Unit -> Int
toEnum :: Int -> Unit
$ctoEnum :: Int -> Unit
pred :: Unit -> Unit
$cpred :: Unit -> Unit
succ :: Unit -> Unit
$csucc :: Unit -> Unit
Enum, Unit
forall a. a -> a -> Bounded a
maxBound :: Unit
$cmaxBound :: Unit
minBound :: Unit
$cminBound :: Unit
Bounded, Eq Unit
Unit -> Unit -> Bool
Unit -> Unit -> Ordering
Unit -> Unit -> Unit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Unit -> Unit -> Unit
$cmin :: Unit -> Unit -> Unit
max :: Unit -> Unit -> Unit
$cmax :: Unit -> Unit -> Unit
>= :: Unit -> Unit -> Bool
$c>= :: Unit -> Unit -> Bool
> :: Unit -> Unit -> Bool
$c> :: Unit -> Unit -> Bool
<= :: Unit -> Unit -> Bool
$c<= :: Unit -> Unit -> Bool
< :: Unit -> Unit -> Bool
$c< :: Unit -> Unit -> Bool
compare :: Unit -> Unit -> Ordering
$ccompare :: Unit -> Unit -> Ordering
Ord)

-- | List of all SI units.
siUnits :: [Unit]
siUnits :: [Unit]
siUnits
  = [ Unit
Quecto
    , Unit
Ronto
    , Unit
Yocto
    , Unit
Zepto
    , Unit
Atto
    , Unit
Femto
    , Unit
Pico
    , Unit
Nano
    , Unit
Micro
    , Unit
Milli
    , Unit
Centi
    , Unit
Deci
    , Unit
Deka
    , Unit
Hecto
    , Unit
Kilo
    , Unit
Mega
    , Unit
Giga
    , Unit
Tera
    , Unit
Peta
    , Unit
Exa
    , Unit
Zetta
    , Unit
Yotta
    , Unit
Ronna
    , Unit
Quetta
    ]

-- | List of binary units.
binaryUnits :: [Unit]
binaryUnits :: [Unit]
binaryUnits = [Unit
Kibi, Unit
Mebi, Unit
Gibi, Unit
Tebi, Unit
Pebi, Unit
Exbi]

-- | List of units which are supraunitary (their multiplier is greater
-- than one).
siSupraunitary :: [Unit]
siSupraunitary :: [Unit]
siSupraunitary = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>= Unit
Deka) [Unit]
siUnits

-- | List of SI units which are greater or equal to 'Kilo'.
siKMGT :: [Unit]
siKMGT :: [Unit]
siKMGT = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>= Unit
Kilo) [Unit]
siUnits

-- | The base for SI units.
siBase :: Rational
siBase :: Rational
siBase = Rational
10

-- | The base for binary units.
binaryBase :: Rational
binaryBase :: Rational
binaryBase = Rational
2

-- | Returns the unit scaling \"multiplier\" (which can be either
-- supra- or sub-unitary):
--
-- >>> unitMultiplier Micro
-- 1 % 1000000
-- >>> unitMultiplier Mebi
-- 1048576 % 1
unitMultiplier :: Unit -> Rational
unitMultiplier :: Unit -> Rational
unitMultiplier Unit
Quecto = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (-Int
30 :: Int)
unitMultiplier Unit
Ronto  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (-Int
27 :: Int)
unitMultiplier Unit
Yocto  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (-Int
24 :: Int)
unitMultiplier Unit
Zepto  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (-Int
21 :: Int)
unitMultiplier Unit
Atto   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (-Int
18 :: Int)
unitMultiplier Unit
Femto  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (-Int
15 :: Int)
unitMultiplier Unit
Pico   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (-Int
12 :: Int)
unitMultiplier Unit
Nano   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( -Int
9 :: Int)
unitMultiplier Unit
Micro  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( -Int
6 :: Int)
unitMultiplier Unit
Milli  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( -Int
3 :: Int)
unitMultiplier Unit
Centi  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( -Int
2 :: Int)
unitMultiplier Unit
Deci   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( -Int
1 :: Int)
unitMultiplier Unit
Deka   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (  Int
1 :: Int)
unitMultiplier Unit
Hecto  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (  Int
2 :: Int)
unitMultiplier Unit
Kilo   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (  Int
3 :: Int)
unitMultiplier Unit
Kibi   = Rational
binaryBase forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
10 :: Int)
unitMultiplier Unit
Mega   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (  Int
6 :: Int)
unitMultiplier Unit
Mebi   = Rational
binaryBase forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
20 :: Int)
unitMultiplier Unit
Giga   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (  Int
9 :: Int)
unitMultiplier Unit
Gibi   = Rational
binaryBase forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
30 :: Int)
unitMultiplier Unit
Tera   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
12 :: Int)
unitMultiplier Unit
Tebi   = Rational
binaryBase forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
40 :: Int)
unitMultiplier Unit
Peta   = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
15 :: Int)
unitMultiplier Unit
Pebi   = Rational
binaryBase forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
50 :: Int)
unitMultiplier Unit
Exa    = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
18 :: Int)
unitMultiplier Unit
Exbi   = Rational
binaryBase forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
60 :: Int)
unitMultiplier Unit
Zetta  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
21 :: Int)
unitMultiplier Unit
Yotta  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
24 :: Int)
unitMultiplier Unit
Ronna  = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
27 :: Int)
unitMultiplier Unit
Quetta = Rational
siBase     forall a b. (Fractional a, Integral b) => a -> b -> a
^^ ( Int
30 :: Int)

-- | Returns the unit full name.
unitName :: Unit -> String
unitName :: Unit -> String
unitName Unit
Quecto = String
"quecto"
unitName Unit
Ronto  = String
"ronto"
unitName Unit
Yocto  = String
"yocto"
unitName Unit
Zepto  = String
"zepto"
unitName Unit
Atto   = String
"atto"
unitName Unit
Femto  = String
"femto"
unitName Unit
Pico   = String
"pico"
unitName Unit
Nano   = String
"nano"
unitName Unit
Micro  = String
"micro"
unitName Unit
Milli  = String
"milli"
unitName Unit
Centi  = String
"centi"
unitName Unit
Deci   = String
"deci"
unitName Unit
Deka   = String
"deka"
unitName Unit
Hecto  = String
"hecto"
unitName Unit
Kilo   = String
"kilo"
unitName Unit
Kibi   = String
"kibi"
unitName Unit
Mega   = String
"mega"
unitName Unit
Mebi   = String
"mebi"
unitName Unit
Giga   = String
"giga"
unitName Unit
Gibi   = String
"gibi"
unitName Unit
Tera   = String
"tera"
unitName Unit
Tebi   = String
"tebi"
unitName Unit
Peta   = String
"peta"
unitName Unit
Pebi   = String
"pebi"
unitName Unit
Exa    = String
"exa"
unitName Unit
Exbi   = String
"exbi"
unitName Unit
Zetta  = String
"zetta"
unitName Unit
Yotta  = String
"yotta"
unitName Unit
Ronna  = String
"ronna"
unitName Unit
Quetta = String
"quetta"

-- | Returns the unit ASCII symbol.
unitSymbol :: Unit -> String
unitSymbol :: Unit -> String
unitSymbol Unit
Quecto = String
"q"
unitSymbol Unit
Ronto  = String
"r"
unitSymbol Unit
Yocto  = String
"y"
unitSymbol Unit
Zepto  = String
"z"
unitSymbol Unit
Atto   = String
"a"
unitSymbol Unit
Femto  = String
"f"
unitSymbol Unit
Pico   = String
"p"
unitSymbol Unit
Nano   = String
"n"
unitSymbol Unit
Micro  = String
"u"
unitSymbol Unit
Milli  = String
"m"
unitSymbol Unit
Centi  = String
"c"
unitSymbol Unit
Deci   = String
"d"
unitSymbol Unit
Deka   = String
"da"
unitSymbol Unit
Hecto  = String
"h"
unitSymbol Unit
Kilo   = String
"k"
unitSymbol Unit
Kibi   = String
"Ki"
unitSymbol Unit
Mega   = String
"M"
unitSymbol Unit
Mebi   = String
"Mi"
unitSymbol Unit
Giga   = String
"G"
unitSymbol Unit
Gibi   = String
"Gi"
unitSymbol Unit
Tera   = String
"T"
unitSymbol Unit
Tebi   = String
"Ti"
unitSymbol Unit
Peta   = String
"P"
unitSymbol Unit
Pebi   = String
"Pi"
unitSymbol Unit
Exa    = String
"E"
unitSymbol Unit
Exbi   = String
"Ei"
unitSymbol Unit
Zetta  = String
"Z"
unitSymbol Unit
Yotta  = String
"Y"
unitSymbol Unit
Ronna  = String
"R"
unitSymbol Unit
Quetta = String
"Q"

-- | Returns the unit symbol, which for the 'Micro' unit is not ASCII.
fancySymbol :: Unit -> String
fancySymbol :: Unit -> String
fancySymbol Unit
Micro = String
"\xb5"
fancySymbol Unit
u = Unit -> String
unitSymbol Unit
u

-- * RationalConvertible

-- | Typeclass for handling values that can be converted to\/from
-- 'Rational'.
class (Real a) => RationalConvertible a where
  -- | Converts the value from Ratioal
  convFromRational :: Rational -> a

instance RationalConvertible Int where
  convFromRational :: Rational -> Int
convFromRational = forall a b. (RealFrac a, Integral b) => a -> b
round

instance RationalConvertible Integer where
  convFromRational :: Rational -> Integer
convFromRational = forall a b. (RealFrac a, Integral b) => a -> b
round

instance RationalConvertible Float where
  convFromRational :: Rational -> Float
convFromRational = forall a. Fractional a => Rational -> a
fromRational

instance RationalConvertible Double where
  convFromRational :: Rational -> Double
convFromRational = forall a. Fractional a => Rational -> a
fromRational

instance RationalConvertible Rational where
  convFromRational :: Rational -> Rational
convFromRational = forall a. a -> a
id

-- | Scales a given value to be represented in the desired unit's scale.
scaleToUnit :: (RationalConvertible a) => a -> Unit -> a
scaleToUnit :: forall a. RationalConvertible a => a -> Unit -> a
scaleToUnit a
val = forall a. RationalConvertible a => Rational -> a
convFromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational
rational_val forall a. Fractional a => a -> a -> a
/) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Rational
unitMultiplier
  where rational_val :: Rational
rational_val = forall a. Real a => a -> Rational
toRational a
val

-- | Scales a given value to units from a given unit's scale.
scaleFromUnit :: (RationalConvertible a) => a -> Unit -> a
scaleFromUnit :: forall a. RationalConvertible a => a -> Unit -> a
scaleFromUnit a
val = forall a. RationalConvertible a => Rational -> a
convFromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational
rational_val forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Rational
unitMultiplier
  where rational_val :: Rational
rational_val = forall a. Real a => a -> Rational
toRational a
val

-- * Formatting functionality

-- | Defines the formatting modes.
data FormatMode
  = FormatSiAll          -- ^ Formats the value using any SI unit.
  | FormatSiSupraunitary -- ^ Formats the value using supraunitary SI
                         -- units only (which means that e.g. @0.001@
                         -- will remain as such instead of being
                         -- formatted as @1m@).
  | FormatSiKMGT         -- ^ Formats the value using units greater or
                         -- equal to 'Kilo'.
  | FormatBinary         -- ^ Formats the value using binary units.
  | FormatUnscaled       -- ^ Formats the value as it is, without
                         -- scaling.
  | FormatFixed Unit     -- ^ Formats the value using the given unit.
    deriving (Int -> FormatMode -> ShowS
[FormatMode] -> ShowS
FormatMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatMode] -> ShowS
$cshowList :: [FormatMode] -> ShowS
show :: FormatMode -> String
$cshow :: FormatMode -> String
showsPrec :: Int -> FormatMode -> ShowS
$cshowsPrec :: Int -> FormatMode -> ShowS
Show)

-- | The available units range for various format modes.
unitRange :: FormatMode -> Either Unit [Unit]
unitRange :: FormatMode -> Either Unit [Unit]
unitRange FormatMode
FormatSiAll          = forall a b. b -> Either a b
Right [Unit]
siUnits
unitRange FormatMode
FormatSiSupraunitary = forall a b. b -> Either a b
Right [Unit]
siSupraunitary
unitRange FormatMode
FormatSiKMGT         = forall a b. b -> Either a b
Right [Unit]
siKMGT
unitRange FormatMode
FormatBinary         = forall a b. b -> Either a b
Right [Unit]
binaryUnits
unitRange FormatMode
FormatUnscaled       = forall a b. b -> Either a b
Right []
unitRange (FormatFixed Unit
u)      = forall a b. a -> Either a b
Left Unit
u

-- | Whether a given value should be scaled (in auto-scaling modes) or
-- not.
shouldScale :: (Num a, Ord a) => a -> Bool
-- FIXME: this is not nice at all: we hardcode the set [1, 10) instead
-- of having it naturally follow from a base unit or similar.
shouldScale :: forall a. (Num a, Ord a) => a -> Bool
shouldScale a
val = a
val forall a. Ord a => a -> a -> Bool
< a
1 Bool -> Bool -> Bool
|| a
val forall a. Ord a => a -> a -> Bool
>= a
10

-- | Computes the recommended unit for displaying a given value. The
-- simple algorithm uses the first unit for which we have a
-- supraunitary representation. In case we don't find any such value
-- (e.g. for a zero value), then 'Nothing' is returned. For
-- `FormatFixed`, we always select the given unit, irrespective of the
-- value.
recommendedUnit :: (Real a) => FormatMode -> a -> Maybe Unit
recommendedUnit :: forall a. Real a => FormatMode -> a -> Maybe Unit
recommendedUnit FormatMode
fmt a
val =
  case FormatMode -> Either Unit [Unit]
unitRange FormatMode
fmt of
    Left Unit
u -> forall a. a -> Maybe a
Just Unit
u
    Right [Unit]
range ->
      if forall a. (Num a, Ord a) => a -> Bool
shouldScale a
val
        then forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Unit
u Maybe Unit
a -> if Rational
ratv forall a. Fractional a => a -> a -> a
/ Unit -> Rational
unitMultiplier Unit
u forall a. Ord a => a -> a -> Bool
>= Rational
1 then forall a. a -> Maybe a
Just Unit
u else Maybe Unit
a)
               forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Unit]
range
        else forall a. Maybe a
Nothing
      where ratv :: Rational
ratv = forall a. Real a => a -> Rational
Prelude.toRational a
val

-- | Computes the scaled value and unit for a given value
formatValue :: (RationalConvertible a) =>
               FormatMode      -- ^ The desired 'FormatMode'
            -> a               -- ^ The value to format
            -> (a, Maybe Unit) -- ^ Scaled value and optional unit
formatValue :: forall a.
RationalConvertible a =>
FormatMode -> a -> (a, Maybe Unit)
formatValue FormatMode
fmt a
val =
  let inverter :: a -> a
inverter = if a
val forall a. Ord a => a -> a -> Bool
< a
0
                   then forall a. Num a => a -> a
negate
                   else forall a. a -> a
id
      val' :: a
val' = a -> a
inverter a
val
      unit :: Maybe Unit
unit = forall a. Real a => FormatMode -> a -> Maybe Unit
recommendedUnit FormatMode
fmt a
val'
      scaled :: a
scaled = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
val' (forall a. RationalConvertible a => a -> Unit -> a
scaleToUnit a
val') Maybe Unit
unit
  in (a -> a
inverter a
scaled, Maybe Unit
unit)

-- | Simple helper to generate the full string representation of an
-- integral value.
showValueWith :: (RationalConvertible a, Show a) =>
                 (Unit -> String)  -- ^ Function to convert the
                                   -- (optional) unit into a
                                   -- string, e.g. 'unitSymbol' or
                                   -- 'fancySymbol'
              -> FormatMode        -- ^ The desired format mode
              -> a                 -- ^ The value to show
              -> String            -- ^ Resulting string
showValueWith :: forall a.
(RationalConvertible a, Show a) =>
(Unit -> String) -> FormatMode -> a -> String
showValueWith Unit -> String
symbfn FormatMode
fmt a
val =
  let (a
scaled, Maybe Unit
unit) = forall a.
RationalConvertible a =>
FormatMode -> a -> (a, Maybe Unit)
formatValue FormatMode
fmt a
val
  in forall a. Show a => a -> String
show a
scaled forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Unit -> String
symbfn Maybe Unit
unit

-- | Generates a final string representation of a value.
showValue :: (RationalConvertible a, Show a) =>
             FormatMode    -- ^ The desired format mode.
          -> a             -- ^ The value to show
          -> String        -- ^ Resulting string
showValue :: forall a.
(RationalConvertible a, Show a) =>
FormatMode -> a -> String
showValue = forall a.
(RationalConvertible a, Show a) =>
(Unit -> String) -> FormatMode -> a -> String
showValueWith Unit -> String
unitSymbol

-- * Parsing functionality

-- | Error message for unknown unit.
unknownUnit :: String -> Either String Unit
unknownUnit :: String -> Either String Unit
unknownUnit String
unit = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unrecognised unit '" forall a. [a] -> [a] -> [a]
++ String
unit forall a. [a] -> [a] -> [a]
++ String
"'"

-- | Parses a symbol in the exact mode. See 'ParseExact' for details.
parseExactSymbol :: String -> Either String Unit
parseExactSymbol :: String -> Either String Unit
parseExactSymbol String
"q"  = forall a b. b -> Either a b
Right Unit
Quecto
parseExactSymbol String
"r"  = forall a b. b -> Either a b
Right Unit
Ronto
parseExactSymbol String
"y"  = forall a b. b -> Either a b
Right Unit
Yocto
parseExactSymbol String
"z"  = forall a b. b -> Either a b
Right Unit
Zepto
parseExactSymbol String
"a"  = forall a b. b -> Either a b
Right Unit
Atto
parseExactSymbol String
"f"  = forall a b. b -> Either a b
Right Unit
Femto
parseExactSymbol String
"p"  = forall a b. b -> Either a b
Right Unit
Pico
parseExactSymbol String
"n"  = forall a b. b -> Either a b
Right Unit
Nano
parseExactSymbol String
"u"  = forall a b. b -> Either a b
Right Unit
Micro
parseExactSymbol String
"m"  = forall a b. b -> Either a b
Right Unit
Milli
parseExactSymbol String
"c"  = forall a b. b -> Either a b
Right Unit
Centi
parseExactSymbol String
"d"  = forall a b. b -> Either a b
Right Unit
Deci
parseExactSymbol String
"da" = forall a b. b -> Either a b
Right Unit
Deka
parseExactSymbol String
"h"  = forall a b. b -> Either a b
Right Unit
Hecto
parseExactSymbol String
"k"  = forall a b. b -> Either a b
Right Unit
Kilo
parseExactSymbol String
"Ki" = forall a b. b -> Either a b
Right Unit
Kibi
parseExactSymbol String
"M"  = forall a b. b -> Either a b
Right Unit
Mega
parseExactSymbol String
"Mi" = forall a b. b -> Either a b
Right Unit
Mebi
parseExactSymbol String
"G"  = forall a b. b -> Either a b
Right Unit
Giga
parseExactSymbol String
"Gi" = forall a b. b -> Either a b
Right Unit
Gibi
parseExactSymbol String
"T"  = forall a b. b -> Either a b
Right Unit
Tera
parseExactSymbol String
"Ti" = forall a b. b -> Either a b
Right Unit
Tebi
parseExactSymbol String
"P"  = forall a b. b -> Either a b
Right Unit
Peta
parseExactSymbol String
"Pi" = forall a b. b -> Either a b
Right Unit
Pebi
parseExactSymbol String
"E"  = forall a b. b -> Either a b
Right Unit
Exa
parseExactSymbol String
"Ei" = forall a b. b -> Either a b
Right Unit
Exbi
parseExactSymbol String
"Z"  = forall a b. b -> Either a b
Right Unit
Zetta
parseExactSymbol String
"Y"  = forall a b. b -> Either a b
Right Unit
Yotta
parseExactSymbol String
"R"  = forall a b. b -> Either a b
Right Unit
Ronna
parseExactSymbol String
"Q"  = forall a b. b -> Either a b
Right Unit
Quetta
parseExactSymbol String
unit = String -> Either String Unit
unknownUnit String
unit

-- | Helper for 'parseBinarySymbol' which only deals with upper-case
-- strings.
helperParseBinary :: String -> Maybe Unit
helperParseBinary :: String -> Maybe Unit
helperParseBinary String
"K"  = forall a. a -> Maybe a
Just Unit
Kibi
helperParseBinary String
"KI" = forall a. a -> Maybe a
Just Unit
Kibi
helperParseBinary String
"M"  = forall a. a -> Maybe a
Just Unit
Mebi
helperParseBinary String
"MI" = forall a. a -> Maybe a
Just Unit
Mebi
helperParseBinary String
"G"  = forall a. a -> Maybe a
Just Unit
Gibi
helperParseBinary String
"GI" = forall a. a -> Maybe a
Just Unit
Gibi
helperParseBinary String
"T"  = forall a. a -> Maybe a
Just Unit
Tebi
helperParseBinary String
"TI" = forall a. a -> Maybe a
Just Unit
Tebi
helperParseBinary String
"P"  = forall a. a -> Maybe a
Just Unit
Pebi
helperParseBinary String
"PI" = forall a. a -> Maybe a
Just Unit
Pebi
helperParseBinary String
"E"  = forall a. a -> Maybe a
Just Unit
Exbi
helperParseBinary String
"EI" = forall a. a -> Maybe a
Just Unit
Exbi
helperParseBinary String
_    = forall a. Maybe a
Nothing

-- | Parses a binary symbol. See 'ParseBinary' for details.
parseBinarySymbol :: String -> Either String Unit
parseBinarySymbol :: String -> Either String Unit
parseBinarySymbol String
symbol =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Unit
unknownUnit String
symbol) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Unit
helperParseBinary forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
upperSym forall a b. (a -> b) -> a -> b
$ String
symbol

-- | Helper for 'parseKMGTSymbol' which only deals with upper-case strings.
helperParseKMGT :: String -> Either String Unit
helperParseKMGT :: String -> Either String Unit
helperParseKMGT String
"K"  = forall a b. b -> Either a b
Right Unit
Kilo
helperParseKMGT String
"KI" = forall a b. b -> Either a b
Right Unit
Kibi
helperParseKMGT String
"M"  = forall a b. b -> Either a b
Right Unit
Mega
helperParseKMGT String
"MI" = forall a b. b -> Either a b
Right Unit
Mebi
helperParseKMGT String
"G"  = forall a b. b -> Either a b
Right Unit
Giga
helperParseKMGT String
"GI" = forall a b. b -> Either a b
Right Unit
Gibi
helperParseKMGT String
"T"  = forall a b. b -> Either a b
Right Unit
Tera
helperParseKMGT String
"TI" = forall a b. b -> Either a b
Right Unit
Tebi
helperParseKMGT String
"P"  = forall a b. b -> Either a b
Right Unit
Peta
helperParseKMGT String
"PI" = forall a b. b -> Either a b
Right Unit
Pebi
helperParseKMGT String
"E"  = forall a b. b -> Either a b
Right Unit
Exa
helperParseKMGT String
"EI" = forall a b. b -> Either a b
Right Unit
Exbi
helperParseKMGT String
"Z"  = forall a b. b -> Either a b
Right Unit
Zetta
helperParseKMGT String
"Y"  = forall a b. b -> Either a b
Right Unit
Yotta
helperParseKMGT String
"R"  = forall a b. b -> Either a b
Right Unit
Ronna
helperParseKMGT String
"Q"  = forall a b. b -> Either a b
Right Unit
Quetta
-- FIXME: error message will contain upper-case version of the symbol
helperParseKMGT String
symbol = String -> Either String Unit
unknownUnit String
symbol

-- | Parses the given symbol as one of the \"big\" units (kilo/kibi
-- and above). This allows the parsing to be case-insensitive.
parseKMGTSymbol :: String -> Either String Unit
parseKMGTSymbol :: String -> Either String Unit
parseKMGTSymbol = String -> Either String Unit
helperParseKMGT forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
upperSym

-- | Defines available parse modes.
data ParseMode
  = ParseExact   -- ^ Exact parser mode. This mode is fully
                 -- case-sensitive.
  | ParseKMGT    -- ^ Parses only units bigger than 'Kilo',
                 -- respectively 'Kibi' (for binary units). This
                 -- allows the parser to be case-insensitive.
  | ParseBinary  -- ^ Parses binary units only. In this mode, both the
                 -- exact and shortened forms are accepted (e.g. both
                 -- \"k\" and \"ki\" will be converted into
                 -- 'Kibi'). Furthermore, the parsing is
                 -- case-insensitive.
    deriving (Int -> ParseMode -> ShowS
[ParseMode] -> ShowS
ParseMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseMode] -> ShowS
$cshowList :: [ParseMode] -> ShowS
show :: ParseMode -> String
$cshow :: ParseMode -> String
showsPrec :: Int -> ParseMode -> ShowS
$cshowsPrec :: Int -> ParseMode -> ShowS
Show, Int -> ParseMode
ParseMode -> Int
ParseMode -> [ParseMode]
ParseMode -> ParseMode
ParseMode -> ParseMode -> [ParseMode]
ParseMode -> ParseMode -> ParseMode -> [ParseMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ParseMode -> ParseMode -> ParseMode -> [ParseMode]
$cenumFromThenTo :: ParseMode -> ParseMode -> ParseMode -> [ParseMode]
enumFromTo :: ParseMode -> ParseMode -> [ParseMode]
$cenumFromTo :: ParseMode -> ParseMode -> [ParseMode]
enumFromThen :: ParseMode -> ParseMode -> [ParseMode]
$cenumFromThen :: ParseMode -> ParseMode -> [ParseMode]
enumFrom :: ParseMode -> [ParseMode]
$cenumFrom :: ParseMode -> [ParseMode]
fromEnum :: ParseMode -> Int
$cfromEnum :: ParseMode -> Int
toEnum :: Int -> ParseMode
$ctoEnum :: Int -> ParseMode
pred :: ParseMode -> ParseMode
$cpred :: ParseMode -> ParseMode
succ :: ParseMode -> ParseMode
$csucc :: ParseMode -> ParseMode
Enum, ParseMode
forall a. a -> a -> Bounded a
maxBound :: ParseMode
$cmaxBound :: ParseMode
minBound :: ParseMode
$cminBound :: ParseMode
Bounded)

-- | Defines unit handling mode on parse.
data ParseOptions
  = UnitRequired     -- ^ Requires that the input string
                     -- has a unit.
  | UnitDefault Unit -- ^ If unit is missing, use a
                     -- default one.
  | UnitOptional     -- ^ The unit is optional, a missing
                     -- one means the value is not
                     -- scaled.
    deriving (Int -> ParseOptions -> ShowS
[ParseOptions] -> ShowS
ParseOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseOptions] -> ShowS
$cshowList :: [ParseOptions] -> ShowS
show :: ParseOptions -> String
$cshow :: ParseOptions -> String
showsPrec :: Int -> ParseOptions -> ShowS
$cshowsPrec :: Int -> ParseOptions -> ShowS
Show)

-- | Parses a unit from a string. The exact parsing mode determines
-- the rules for parsing and the range of possible units.
parseSymbol :: ParseMode -> String -> Either String Unit
parseSymbol :: ParseMode -> String -> Either String Unit
parseSymbol ParseMode
ParseExact = String -> Either String Unit
parseExactSymbol
parseSymbol ParseMode
ParseKMGT = String -> Either String Unit
parseKMGTSymbol
parseSymbol ParseMode
ParseBinary = String -> Either String Unit
parseBinarySymbol

-- | Main parse routine.
parseValue :: (Read a, RationalConvertible a) =>
                ParseMode       -- ^ The desired parse mode
             -> String          -- ^ String to be parsed
             -> Either String a -- ^ Either a Left error message, or
                                -- a Right parsed value
parseValue :: forall a.
(Read a, RationalConvertible a) =>
ParseMode -> String -> Either String a
parseValue = forall a.
(Read a, RationalConvertible a) =>
ParseOptions -> [Unit] -> ParseMode -> String -> Either String a
parseGeneric ParseOptions
UnitOptional []

-- | Validate a parsed unit using a given valid options list.
validUnit :: [Unit] -> Unit -> Either String Unit
validUnit :: [Unit] -> Unit -> Either String Unit
validUnit [] Unit
unit = forall a b. b -> Either a b
Right Unit
unit
validUnit [Unit]
ulist Unit
unit =
  if Unit
unit forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Unit]
ulist
     then forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unit '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Unit
unit forall a. [a] -> [a] -> [a]
++ String
"' not part of the accepted" forall a. [a] -> [a] -> [a]
++
            String
" unit list (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Unit]
ulist) forall a. [a] -> [a] -> [a]
++ String
")"
    else forall a b. b -> Either a b
Right Unit
unit

-- | Parses a string unit depending on the various options and modes.
processUnit :: ParseOptions
            -> ParseMode
            -> [Unit]
            -> String
            -> Either String (Maybe Unit)
processUnit :: ParseOptions
-> ParseMode -> [Unit] -> String -> Either String (Maybe Unit)
processUnit ParseOptions
UnitRequired    ParseMode
_ [Unit]
_ String
"" =
  forall a b. a -> Either a b
Left String
"An unit is required but the input string lacks one"
processUnit (UnitDefault Unit
u) ParseMode
_ [Unit]
_ String
"" = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Unit
u
processUnit  ParseOptions
UnitOptional   ParseMode
_ [Unit]
_ String
"" = forall a b. b -> Either a b
Right   forall a. Maybe a
Nothing
processUnit ParseOptions
_ ParseMode
pmode [Unit]
valid_units String
unit_suffix =
  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just (ParseMode -> String -> Either String Unit
parseSymbol ParseMode
pmode String
unit_suffix forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Unit] -> Unit -> Either String Unit
validUnit [Unit]
valid_units)

-- | Low-level parse routine. Takes two function arguments which fix
-- the initial and final conversion, a parse mode and the string to be
-- parsed.
parseGeneric :: (Read a, RationalConvertible a) =>
                ParseOptions    -- ^ Unit options
             -> [Unit]          -- ^ Optional list of valid units
             -> ParseMode       -- ^ The desired parse mode
             -> String          -- ^ String to be parsed
             -> Either String a
parseGeneric :: forall a.
(Read a, RationalConvertible a) =>
ParseOptions -> [Unit] -> ParseMode -> String -> Either String a
parseGeneric ParseOptions
popts [Unit]
valid_units ParseMode
pmode String
str =
  case forall a. Read a => ReadS a
reads String
str of
    [(a
v, String
suffix)] ->
      let unit_suffix :: String
unit_suffix = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') String
suffix
          unit :: Either String (Maybe Unit)
unit = ParseOptions
-> ParseMode -> [Unit] -> String -> Either String (Maybe Unit)
processUnit ParseOptions
popts ParseMode
pmode [Unit]
valid_units String
unit_suffix
      in forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
v (forall a. RationalConvertible a => a -> Unit -> a
scaleFromUnit a
v) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Either String (Maybe Unit)
unit
    [(a, String)]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Can't parse string '" forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
"'"

-- | Converts a string to upper-case.
upperSym :: String -> String
upperSym :: ShowS
upperSym = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper