Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
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.
Synopsis
- data Unit
- class Real a => RationalConvertible a where
- convFromRational :: Rational -> a
- siUnits :: [Unit]
- siSupraunitary :: [Unit]
- siKMGT :: [Unit]
- binaryUnits :: [Unit]
- siBase :: Rational
- binaryBase :: Rational
- unitMultiplier :: Unit -> Rational
- unitName :: Unit -> String
- unitSymbol :: Unit -> String
- fancySymbol :: Unit -> String
- data FormatMode
- recommendedUnit :: Real a => FormatMode -> a -> Maybe Unit
- formatValue :: RationalConvertible a => FormatMode -> a -> (a, Maybe Unit)
- showValue :: (RationalConvertible a, Show a) => FormatMode -> a -> String
- data ParseMode
- parseSymbol :: ParseMode -> String -> Either String Unit
- parseValue :: (Read a, RationalConvertible a) => ParseMode -> String -> Either String a
- unitRange :: FormatMode -> Either Unit [Unit]
- data ParseOptions
- parseExactSymbol :: String -> Either String Unit
- parseBinarySymbol :: String -> Either String Unit
- parseKMGTSymbol :: String -> Either String Unit
- parseGeneric :: (Read a, RationalConvertible a) => ParseOptions -> [Unit] -> ParseMode -> String -> Either String a
- showValueWith :: (RationalConvertible a, Show a) => (Unit -> String) -> FormatMode -> a -> String
Basic definitions
Types
The unit type.
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 |
class Real a => RationalConvertible a where Source #
Typeclass for handling values that can be converted to/from
Rational
.
convFromRational :: Rational -> a Source #
Converts the value from Ratioal
Instances
RationalConvertible Rational Source # | |
Defined in Data.Prefix.Units convFromRational :: Rational -> Rational Source # | |
RationalConvertible Integer Source # | |
Defined in Data.Prefix.Units convFromRational :: Rational -> Integer Source # | |
RationalConvertible Double Source # | |
Defined in Data.Prefix.Units convFromRational :: Rational -> Double Source # | |
RationalConvertible Float Source # | |
Defined in Data.Prefix.Units convFromRational :: Rational -> Float Source # | |
RationalConvertible Int Source # | |
Defined in Data.Prefix.Units convFromRational :: Rational -> Int Source # |
siSupraunitary :: [Unit] Source #
List of units which are supraunitary (their multiplier is greater than one).
binaryUnits :: [Unit] Source #
List of binary units.
binaryBase :: Rational Source #
The base for binary units.
Unit-related functions
unitMultiplier :: Unit -> Rational Source #
Returns the unit scaling "multiplier" (which can be either supra- or sub-unitary):
>>>
unitMultiplier Micro
1 % 1000000>>>
unitMultiplier Mebi
1048576 % 1
unitSymbol :: Unit -> String Source #
Returns the unit ASCII symbol.
fancySymbol :: Unit -> String Source #
Returns the unit symbol, which for the Micro
unit is not ASCII.
Formatting functions
data FormatMode Source #
Defines the formatting modes.
FormatSiAll | Formats the value using any SI unit. |
FormatSiSupraunitary | Formats the value using supraunitary SI
units only (which means that e.g. |
FormatSiKMGT | Formats the value using units greater or
equal to |
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. |
Instances
Show FormatMode Source # | |
Defined in Data.Prefix.Units showsPrec :: Int -> FormatMode -> ShowS # show :: FormatMode -> String # showList :: [FormatMode] -> ShowS # |
recommendedUnit :: Real a => FormatMode -> a -> Maybe Unit Source #
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.
:: RationalConvertible a | |
=> FormatMode | The desired |
-> a | The value to format |
-> (a, Maybe Unit) | Scaled value and optional unit |
Computes the scaled value and unit for a given value
:: (RationalConvertible a, Show a) | |
=> FormatMode | The desired format mode. |
-> a | The value to show |
-> String | Resulting string |
Generates a final string representation of a value.
Parsing functions
Defines available parse modes.
ParseExact | Exact parser mode. This mode is fully case-sensitive. |
ParseKMGT | Parses only units bigger than |
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
|
Instances
Bounded ParseMode Source # | |
Enum ParseMode Source # | |
Defined in Data.Prefix.Units succ :: ParseMode -> ParseMode # pred :: ParseMode -> ParseMode # fromEnum :: ParseMode -> Int # enumFrom :: ParseMode -> [ParseMode] # enumFromThen :: ParseMode -> ParseMode -> [ParseMode] # enumFromTo :: ParseMode -> ParseMode -> [ParseMode] # enumFromThenTo :: ParseMode -> ParseMode -> ParseMode -> [ParseMode] # | |
Show ParseMode Source # | |
parseSymbol :: ParseMode -> String -> Either String Unit Source #
Parses a unit from a string. The exact parsing mode determines the rules for parsing and the range of possible units.
:: (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 |
Main parse routine.
Low-level generic functions
unitRange :: FormatMode -> Either Unit [Unit] Source #
The available units range for various format modes.
Parsing
data ParseOptions Source #
Defines unit handling mode on parse.
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. |
Instances
Show ParseOptions Source # | |
Defined in Data.Prefix.Units showsPrec :: Int -> ParseOptions -> ShowS # show :: ParseOptions -> String # showList :: [ParseOptions] -> ShowS # |
parseExactSymbol :: String -> Either String Unit Source #
Parses a symbol in the exact mode. See ParseExact
for details.
parseBinarySymbol :: String -> Either String Unit Source #
Parses a binary symbol. See ParseBinary
for details.
parseKMGTSymbol :: String -> Either String Unit Source #
Parses the given symbol as one of the "big" units (kilo/kibi and above). This allows the parsing to be case-insensitive.
:: (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 |
Low-level parse routine. Takes two function arguments which fix the initial and final conversion, a parse mode and the string to be parsed.
Formatting
:: (RationalConvertible a, Show a) | |
=> (Unit -> String) | Function to convert the
(optional) unit into a
string, e.g. |
-> FormatMode | The desired format mode |
-> a | The value to show |
-> String | Resulting string |
Simple helper to generate the full string representation of an integral value.