safe-money-0.2: Type-safe and lossless encoding and manipulation of money, world currencies and precious metals.

Safe HaskellNone
LanguageHaskell2010

Data.Money

Contents

Description

Import this module qualified:

import qualified Data.Money as Money

Synopsis

Dense monetary values

data Dense currency Source #

Dense represents a dense monetary value for currency (usually a ISO-4217 currency code, but not necessarily) as a rational number.

While monetary values associated with a particular currency are discrete, you can still treat monetary values as dense while operating on them. For example, the half of USD 3.41 is USD 1.705, which is not an amount that can't be represented as a number of USD cents (the smallest unit that can represent USD amounts). Nevertheless, if you eventually multiply USD 1.705 by 4, for example, you end up with USD 6.82, which is again a value representable as USD cents. In other words, Dense monetary values allow us to perform precise calculations deferring the conversion to a Discrete monetary values as much as posible. Once you are ready to aproximate a Dense value to a Discrete value you can use one of round, floor, ceiling or truncate. Otherwise, using toRational you can obtain a precise Rational representation.

Construct Dense monetary values using dense, or fromInteger / fromIntegral if that suffices.

WARNING if you want to treat a dense monetary value as a Real number (for example, to take the square root of that monetary value), then you are on your own. We can only guarantee lossless manipulation of rational values, so you will need to convert back and forth betwen the Rational representation for Dense and your (likely lossy) representation for Real numbers.

Instances

Eq (Dense currency) Source # 

Methods

(==) :: Dense currency -> Dense currency -> Bool #

(/=) :: Dense currency -> Dense currency -> Bool #

Fractional (Dense currency) Source # 

Methods

(/) :: Dense currency -> Dense currency -> Dense currency #

recip :: Dense currency -> Dense currency #

fromRational :: Rational -> Dense currency #

Num (Dense currency) Source # 

Methods

(+) :: Dense currency -> Dense currency -> Dense currency #

(-) :: Dense currency -> Dense currency -> Dense currency #

(*) :: Dense currency -> Dense currency -> Dense currency #

negate :: Dense currency -> Dense currency #

abs :: Dense currency -> Dense currency #

signum :: Dense currency -> Dense currency #

fromInteger :: Integer -> Dense currency #

Ord (Dense currency) Source # 

Methods

compare :: Dense currency -> Dense currency -> Ordering #

(<) :: Dense currency -> Dense currency -> Bool #

(<=) :: Dense currency -> Dense currency -> Bool #

(>) :: Dense currency -> Dense currency -> Bool #

(>=) :: Dense currency -> Dense currency -> Bool #

max :: Dense currency -> Dense currency -> Dense currency #

min :: Dense currency -> Dense currency -> Dense currency #

KnownSymbol currency => Read (Dense currency) Source # 

Methods

readsPrec :: Int -> ReadS (Dense currency) #

readList :: ReadS [Dense currency] #

readPrec :: ReadPrec (Dense currency) #

readListPrec :: ReadPrec [Dense currency] #

Real (Dense currency) Source # 

Methods

toRational :: Dense currency -> Rational #

KnownSymbol currency => Show (Dense currency) Source # 

Methods

showsPrec :: Int -> Dense currency -> ShowS #

show :: Dense currency -> String #

showList :: [Dense currency] -> ShowS #

Generic (Dense currency) Source # 

Associated Types

type Rep (Dense currency) :: * -> * #

Methods

from :: Dense currency -> Rep (Dense currency) x #

to :: Rep (Dense currency) x -> Dense currency #

Hashable (Dense currency) Source # 

Methods

hashWithSalt :: Int -> Dense currency -> Int #

hash :: Dense currency -> Int #

KnownSymbol currency => ToJSON (Dense currency) Source #

Compatible with DenseRep

Methods

toJSON :: Dense currency -> Value #

toEncoding :: Dense currency -> Encoding #

toJSONList :: [Dense currency] -> Value #

toEncodingList :: [Dense currency] -> Encoding #

KnownSymbol currency => FromJSON (Dense currency) Source #

Compatible with DenseRep

Methods

parseJSON :: Value -> Parser (Dense currency) #

parseJSONList :: Value -> Parser [Dense currency] #

KnownSymbol currency => Binary (Dense currency) Source #

Compatible with DenseRep.

Methods

put :: Dense currency -> Put #

get :: Get (Dense currency) #

putList :: [Dense currency] -> Put #

KnownSymbol currency => Serialize (Dense currency) Source #

Compatible with DenseRep.

Methods

put :: Putter (Dense currency) #

get :: Get (Dense currency) #

NFData (Dense currency) Source # 

Methods

rnf :: Dense currency -> () #

KnownSymbol currency => Store (Dense currency) Source #

Compatible with DenseRep.

Methods

size :: Size (Dense currency) #

poke :: Dense currency -> Poke () #

peek :: Peek (Dense currency) #

type Rep (Dense currency) Source # 
type Rep (Dense currency) = D1 (MetaData "Dense" "Data.Money.Internal" "safe-money-0.2-9KEKOJrropPa8pssJxMaR" True) (C1 (MetaCons "Dense" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Rational)))

dense :: Rational -> Maybe (Dense currency) Source #

Build a Dense monetary value from a Rational value.

For example, if you want to represent USD 12.52316, then you can use:

dense (125316 % 10000)

This function returns Nothing in case the given Rational is infinity or notANumber.

Discrete monetary values

type Discrete currency unit = Discrete' currency (Scale currency unit) Source #

Discrete represents a discrete monetary value for a currency expresed as an integer amount of a particular unit. For example, with currency ~ "USD" and unit ~ "cent" you can represent United States Dollars to their full extent.

currency is usually a ISO-4217 currency code, but not necessarily.

Construct Discrete values using fromInteger.

For example, if you want to represent GBP 21.05, where the smallest represetable unit for a GBP (United Kingdom Pound) is the penny, and 100 pennies equal 1 GBP (i.e., Scale "GBP" ~ '(100, 1)), then you can use:

fromInteger 2105 :: Discrete "GBP" "penny"

Because 2015 / 100 == 20.15.

data Discrete' currency scale Source #

Discrete' represents a discrete monetary value for a currency expresed as an amount of scale, which is a rational number expressed as (numerator, denominator).

You'll be using Discrete instead of Discrete' most of the time, which mentions the unit name (such as cent or centavo) instead of explicitely mentioning the unit scale.

Instances

GoodScale scale => Enum (Discrete' currency scale) Source # 

Methods

succ :: Discrete' currency scale -> Discrete' currency scale #

pred :: Discrete' currency scale -> Discrete' currency scale #

toEnum :: Int -> Discrete' currency scale #

fromEnum :: Discrete' currency scale -> Int #

enumFrom :: Discrete' currency scale -> [Discrete' currency scale] #

enumFromThen :: Discrete' currency scale -> Discrete' currency scale -> [Discrete' currency scale] #

enumFromTo :: Discrete' currency scale -> Discrete' currency scale -> [Discrete' currency scale] #

enumFromThenTo :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale -> [Discrete' currency scale] #

GoodScale scale => Eq (Discrete' currency scale) Source # 

Methods

(==) :: Discrete' currency scale -> Discrete' currency scale -> Bool #

(/=) :: Discrete' currency scale -> Discrete' currency scale -> Bool #

(TypeError Constraint ((:$$:) ((:$$:) ((:<>:) ((:<>:) ((:<>:) (Text "The ") (ShowType (Symbol -> (Nat, Nat) -> *) Discrete')) (Text " type is deliberately not a ")) (ShowType (* -> Constraint) Fractional)) ((:<>:) ((:<>:) ((:<>:) (Text "instance. Convert the ") (ShowType (Symbol -> (Nat, Nat) -> *) Discrete')) (Text " value to a ")) (ShowType (Symbol -> *) Dense))) ((:<>:) ((:<>:) (Text "value and use the ") (ShowType (* -> Constraint) Fractional)) (Text " features on it instead."))), GoodScale scale) => Fractional (Discrete' currency scale) Source # 

Methods

(/) :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

recip :: Discrete' currency scale -> Discrete' currency scale #

fromRational :: Rational -> Discrete' currency scale #

GoodScale scale => Integral (Discrete' currency scale) Source # 

Methods

quot :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

rem :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

div :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

mod :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

quotRem :: Discrete' currency scale -> Discrete' currency scale -> (Discrete' currency scale, Discrete' currency scale) #

divMod :: Discrete' currency scale -> Discrete' currency scale -> (Discrete' currency scale, Discrete' currency scale) #

toInteger :: Discrete' currency scale -> Integer #

GoodScale scale => Num (Discrete' currency scale) Source # 

Methods

(+) :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

(-) :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

(*) :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

negate :: Discrete' currency scale -> Discrete' currency scale #

abs :: Discrete' currency scale -> Discrete' currency scale #

signum :: Discrete' currency scale -> Discrete' currency scale #

fromInteger :: Integer -> Discrete' currency scale #

GoodScale scale => Ord (Discrete' currency scale) Source # 

Methods

compare :: Discrete' currency scale -> Discrete' currency scale -> Ordering #

(<) :: Discrete' currency scale -> Discrete' currency scale -> Bool #

(<=) :: Discrete' currency scale -> Discrete' currency scale -> Bool #

(>) :: Discrete' currency scale -> Discrete' currency scale -> Bool #

(>=) :: Discrete' currency scale -> Discrete' currency scale -> Bool #

max :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

min :: Discrete' currency scale -> Discrete' currency scale -> Discrete' currency scale #

(KnownSymbol currency, GoodScale scale) => Read (Discrete' currency scale) Source # 

Methods

readsPrec :: Int -> ReadS (Discrete' currency scale) #

readList :: ReadS [Discrete' currency scale] #

readPrec :: ReadPrec (Discrete' currency scale) #

readListPrec :: ReadPrec [Discrete' currency scale] #

GoodScale scale => Real (Discrete' currency scale) Source # 

Methods

toRational :: Discrete' currency scale -> Rational #

(KnownSymbol currency, GoodScale scale) => Show (Discrete' currency scale) Source # 

Methods

showsPrec :: Int -> Discrete' currency scale -> ShowS #

show :: Discrete' currency scale -> String #

showList :: [Discrete' currency scale] -> ShowS #

GoodScale scale => Generic (Discrete' currency scale) Source # 

Associated Types

type Rep (Discrete' currency scale) :: * -> * #

Methods

from :: Discrete' currency scale -> Rep (Discrete' currency scale) x #

to :: Rep (Discrete' currency scale) x -> Discrete' currency scale #

GoodScale scale => Hashable (Discrete' currency scale) Source # 

Methods

hashWithSalt :: Int -> Discrete' currency scale -> Int #

hash :: Discrete' currency scale -> Int #

(KnownSymbol currency, GoodScale scale) => ToJSON (Discrete' currency scale) Source #

Compatible with DiscreteRep

Methods

toJSON :: Discrete' currency scale -> Value #

toEncoding :: Discrete' currency scale -> Encoding #

toJSONList :: [Discrete' currency scale] -> Value #

toEncodingList :: [Discrete' currency scale] -> Encoding #

(KnownSymbol currency, GoodScale scale) => FromJSON (Discrete' currency scale) Source #

Compatible with DiscreteRep

Methods

parseJSON :: Value -> Parser (Discrete' currency scale) #

parseJSONList :: Value -> Parser [Discrete' currency scale] #

(KnownSymbol currency, GoodScale scale) => Binary (Discrete' currency scale) Source #

Compatible with DiscreteRep.

Methods

put :: Discrete' currency scale -> Put #

get :: Get (Discrete' currency scale) #

putList :: [Discrete' currency scale] -> Put #

(KnownSymbol currency, GoodScale scale) => Serialize (Discrete' currency scale) Source #

Compatible with DiscreteRep.

Methods

put :: Putter (Discrete' currency scale) #

get :: Get (Discrete' currency scale) #

GoodScale scale => NFData (Discrete' currency scale) Source # 

Methods

rnf :: Discrete' currency scale -> () #

(KnownSymbol currency, GoodScale scale) => Store (Discrete' currency scale) Source #

Compatible with DiscreteRep.

Methods

size :: Size (Discrete' currency scale) #

poke :: Discrete' currency scale -> Poke () #

peek :: Peek (Discrete' currency scale) #

type Rep (Discrete' currency scale) Source # 
type Rep (Discrete' currency scale) = D1 (MetaData "Discrete'" "Data.Money.Internal" "safe-money-0.2-9KEKOJrropPa8pssJxMaR" True) (C1 (MetaCons "Discrete" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer)))

fromDiscrete Source #

Arguments

:: GoodScale scale 
=> Discrete' currency scale 
-> Dense currency 

Convert currency Discrete monetary value into a Dense monetary value.

round Source #

Arguments

:: GoodScale scale 
=> Dense currency 
-> (Discrete' currency scale, Maybe (Dense currency)) 

Round a Dense value x to the nearest value fully representable in its currency's unit Scale, which might be x itself.

If x is already fully representable in its currency's unit Scale, then the following holds:

round x == (x, Nothing)

Otherwise, if the nearest value to x that is fully representable in its currency's unit Scale is greater than x, then the following holds:

round == ceiling

Otherwise, the nearest value to x that is fully representable in its currency's unit Scale is smaller than x, and the following holds:

round == floor

Proof that round doesn't lose money:

x == case round x of
       (y, Nothing) -> y
       (y, Just z)  -> y + z

ceiling Source #

Arguments

:: GoodScale scale 
=> Dense currency 
-> (Discrete' currency scale, Maybe (Dense currency)) 

Round a Dense value x to the nearest value fully representable in its currency's unit Scale which is greater than x or equal to x.

If x is already fully representable in its currency's unit Scale, then the following holds:

ceiling x == (x, Nothing)

Otherwise, if x is not representable in its currency's unit Scale, then the following holds:

ceiling x == (y, Just z)
x /= y
z < zero

Proof that ceiling doesn't lose money:

x == case ceiling x of
       (y, Nothing) -> y
       (y, Just z)  -> y + z

floor Source #

Arguments

:: GoodScale scale 
=> Dense currency 
-> (Discrete' currency scale, Maybe (Dense currency)) 

Round a Dense value x to the nearest value fully representable in its currency's unit Scale which is smaller than x or equal to x.

If x is already fully representable in its currency's unit Scale, then the following holds:

floor x == (x, Nothing)

Otherwise, if x is not representable in its currency's unit Scale, then the following holds:

floor x == (y, Just z)
x /= y
z > zero

Proof that floor doesn't lose money:

x == case floor x of
       (y, Nothing) -> y
       (y, Just z)  -> y + z

truncate Source #

Arguments

:: GoodScale scale 
=> Dense currency 
-> (Discrete' currency scale, Maybe (Dense currency)) 

Round a Dense value x to the nearest value between zero and x (inclusive) which is fully representable in its currency's unit Scale.

If x is already fully representable in its currency's unit Scale, then the following holds:

truncate x == (x, Nothing)

Otherwise, if x is positive, then the following holds:

truncate == floor

Otherwise, if x is negative, the following holds:

truncate == ceiling

Proof that truncate doesn't lose money:

x == case truncate x of
       (y, Nothing) -> y
       (y, Just z)  -> y + z

Currency scales

type family Scale (currency :: Symbol) (unit :: Symbol) :: (Nat, Nat) Source #

Scale currency unit is a rational number (expressed as '(numerator, denominator)) indicating how many pieces of unit fit in currency.

currency is usually a ISO-4217 currency code, but not necessarily.

The Scale will determine how to convert a Dense value into a Discrete value and vice-versa.

For example, there are 100 USD cents in 1 USD, so the scale for this relationship is:

type instance Scale "USD" "cent" = '(100, 1)

As another example, there is 1 dollar in USD, so the scale for this relationship is:

type instance Scale "USD" "dollar" = '(1, 1)

When using Discrete values to represent money, it will be impossible to represent an amount of currency smaller than unit. So, if you decide to use Scale "USD" "dollar" as your scale, you will not be able to represent values such as USD 3.50 or USD 21.87, since they are not exact multiples of a dollar.

If there exists a canonical smallest unit that can fully represent the currency, then an instance Scale currency currency exists.

type instance Scale "USD" "USD" = Scale "USD" "cent"

For some monetary values, such as precious metals, the smallest representable unit is not obvious, since you can continue to split the precious metal many times before it stops being a precious metal. Still, for practical purposes we can make a sane arbitrary choice of smallest unit. For example, the base unit for XAU (Gold) is the troy ounce, which is too big to be considered the smallest unit, but we can arbitrarily choose the milligrain as our smallest unit, which is about as heavy as a single grain of table salt and should be sufficiently precise for all monetary practical purposes. A /troy ounce equals 480000 milligrains/.

type instance Scale "XAG" "milligrain" = '(480000, 1)

You can use other units such as milligrams for measuring XAU, for example. However, since the amount of milligrams in a troy ounce (31103.477) is not integral, we need to use rational number to express it.

type instance Scale "XAU" "milligram" = '(31103477, 1000)

If you try to obtain the 'Scale of a currency without an obvious smallest representable unit, like XAU, you will get a compile error.

Instances

type Scale "AED" "AED" Source # 
type Scale "AED" "AED" = (,) Nat Nat 100 1
type Scale "AED" "dirham" Source # 
type Scale "AED" "dirham" = (,) Nat Nat 1 1
type Scale "AED" "fils" Source # 
type Scale "AED" "fils" = (,) Nat Nat 100 1
type Scale "AFN" "AFN" Source # 
type Scale "AFN" "AFN" = (,) Nat Nat 100 1
type Scale "AFN" "afghani" Source # 
type Scale "AFN" "afghani" = (,) Nat Nat 1 1
type Scale "AFN" "pul" Source # 
type Scale "AFN" "pul" = (,) Nat Nat 100 1
type Scale "ALL" "ALL" Source # 
type Scale "ALL" "ALL" = (,) Nat Nat 100 1
type Scale "ALL" "lek" Source # 
type Scale "ALL" "lek" = (,) Nat Nat 1 1
type Scale "ALL" "qindarke" Source # 
type Scale "ALL" "qindarke" = (,) Nat Nat 100 1
type Scale "AMD" "AMD" Source # 
type Scale "AMD" "AMD" = (,) Nat Nat 100 1
type Scale "AMD" "dram" Source # 
type Scale "AMD" "dram" = (,) Nat Nat 1 1
type Scale "AMD" "luma" Source # 
type Scale "AMD" "luma" = (,) Nat Nat 100 1
type Scale "ANG" "ANG" Source # 
type Scale "ANG" "ANG" = (,) Nat Nat 100 1
type Scale "ANG" "cent" Source # 
type Scale "ANG" "cent" = (,) Nat Nat 100 1
type Scale "ANG" "guilder" Source # 
type Scale "ANG" "guilder" = (,) Nat Nat 1 1
type Scale "AOA" "AOA" Source # 
type Scale "AOA" "AOA" = (,) Nat Nat 100 1
type Scale "AOA" "centimo" Source # 
type Scale "AOA" "centimo" = (,) Nat Nat 100 1
type Scale "AOA" "kwanza" Source # 
type Scale "AOA" "kwanza" = (,) Nat Nat 1 1
type Scale "ARS" "ARS" Source # 
type Scale "ARS" "ARS" = (,) Nat Nat 100 1
type Scale "ARS" "centavo" Source # 
type Scale "ARS" "centavo" = (,) Nat Nat 100 1
type Scale "ARS" "peso" Source # 
type Scale "ARS" "peso" = (,) Nat Nat 1 1
type Scale "AUD" "AUD" Source # 
type Scale "AUD" "AUD" = (,) Nat Nat 100 1
type Scale "AUD" "cent" Source # 
type Scale "AUD" "cent" = (,) Nat Nat 100 1
type Scale "AUD" "dollar" Source # 
type Scale "AUD" "dollar" = (,) Nat Nat 1 1
type Scale "AWG" "AWG" Source # 
type Scale "AWG" "AWG" = (,) Nat Nat 100 1
type Scale "AWG" "cent" Source # 
type Scale "AWG" "cent" = (,) Nat Nat 100 1
type Scale "AWG" "florin" Source # 
type Scale "AWG" "florin" = (,) Nat Nat 1 1
type Scale "AZN" "AZN" Source # 
type Scale "AZN" "AZN" = (,) Nat Nat 100 1
type Scale "AZN" "manat" Source # 
type Scale "AZN" "manat" = (,) Nat Nat 1 1
type Scale "AZN" "qapik" Source # 
type Scale "AZN" "qapik" = (,) Nat Nat 100 1
type Scale "BAM" "BAM" Source # 
type Scale "BAM" "BAM" = (,) Nat Nat 100 1
type Scale "BAM" "fening" Source # 
type Scale "BAM" "fening" = (,) Nat Nat 100 1
type Scale "BAM" "mark" Source # 
type Scale "BAM" "mark" = (,) Nat Nat 1 1
type Scale "BBD" "BBD" Source # 
type Scale "BBD" "BBD" = (,) Nat Nat 100 1
type Scale "BBD" "cent" Source # 
type Scale "BBD" "cent" = (,) Nat Nat 100 1
type Scale "BBD" "dollar" Source # 
type Scale "BBD" "dollar" = (,) Nat Nat 1 1
type Scale "BDT" "BDT" Source # 
type Scale "BDT" "BDT" = (,) Nat Nat 100 1
type Scale "BDT" "paisa" Source # 
type Scale "BDT" "paisa" = (,) Nat Nat 100 1
type Scale "BDT" "taka" Source # 
type Scale "BDT" "taka" = (,) Nat Nat 1 1
type Scale "BGN" "BGN" Source # 
type Scale "BGN" "BGN" = (,) Nat Nat 100 1
type Scale "BGN" "lev" Source # 
type Scale "BGN" "lev" = (,) Nat Nat 1 1
type Scale "BGN" "stotinka" Source # 
type Scale "BGN" "stotinka" = (,) Nat Nat 100 1
type Scale "BHD" "BHD" Source # 
type Scale "BHD" "BHD" = (,) Nat Nat 1000 1
type Scale "BHD" "dinar" Source # 
type Scale "BHD" "dinar" = (,) Nat Nat 1 1
type Scale "BHD" "fils" Source # 
type Scale "BHD" "fils" = (,) Nat Nat 1000 1
type Scale "BIF" "BIF" Source # 
type Scale "BIF" "BIF" = (,) Nat Nat 100 1
type Scale "BIF" "centime" Source # 
type Scale "BIF" "centime" = (,) Nat Nat 100 1
type Scale "BIF" "franc" Source # 
type Scale "BIF" "franc" = (,) Nat Nat 1 1
type Scale "BMD" "BMD" Source # 
type Scale "BMD" "BMD" = (,) Nat Nat 100 1
type Scale "BMD" "cent" Source # 
type Scale "BMD" "cent" = (,) Nat Nat 100 1
type Scale "BMD" "dollar" Source # 
type Scale "BMD" "dollar" = (,) Nat Nat 1 1
type Scale "BND" "BND" Source # 
type Scale "BND" "BND" = (,) Nat Nat 100 1
type Scale "BND" "dollar" Source # 
type Scale "BND" "dollar" = (,) Nat Nat 1 1
type Scale "BND" "sen" Source # 
type Scale "BND" "sen" = (,) Nat Nat 100 1
type Scale "BOB" "BOB" Source # 
type Scale "BOB" "BOB" = (,) Nat Nat 100 1
type Scale "BOB" "boliviano" Source # 
type Scale "BOB" "boliviano" = (,) Nat Nat 1 1
type Scale "BOB" "centavo" Source # 
type Scale "BOB" "centavo" = (,) Nat Nat 100 1
type Scale "BOV" "BOV" Source # 
type Scale "BOV" "BOV" = (,) Nat Nat 100 1
type Scale "BRL" "BRL" Source # 
type Scale "BRL" "BRL" = (,) Nat Nat 100 1
type Scale "BRL" "centavo" Source # 
type Scale "BRL" "centavo" = (,) Nat Nat 100 1
type Scale "BRL" "real" Source # 
type Scale "BRL" "real" = (,) Nat Nat 1 1
type Scale "BSD" "BSD" Source # 
type Scale "BSD" "BSD" = (,) Nat Nat 100 1
type Scale "BSD" "cent" Source # 
type Scale "BSD" "cent" = (,) Nat Nat 1 1
type Scale "BSD" "dollar" Source # 
type Scale "BSD" "dollar" = (,) Nat Nat 1 1
type Scale "BTC" "BTC" Source # 
type Scale "BTC" "BTC" = (,) Nat Nat 100000000 1
type Scale "BTC" "bitcoin" Source # 
type Scale "BTC" "bitcoin" = (,) Nat Nat 1 1
type Scale "BTC" "satoshi" Source # 
type Scale "BTC" "satoshi" = (,) Nat Nat 100000000 1
type Scale "BTN" "BTN" Source # 
type Scale "BTN" "BTN" = (,) Nat Nat 100 1
type Scale "BTN" "chetrum" Source # 
type Scale "BTN" "chetrum" = (,) Nat Nat 100 1
type Scale "BTN" "ngultrum" Source # 
type Scale "BTN" "ngultrum" = (,) Nat Nat 1 1
type Scale "BWP" "BWP" Source # 
type Scale "BWP" "BWP" = (,) Nat Nat 100 1
type Scale "BWP" "pula" Source # 
type Scale "BWP" "pula" = (,) Nat Nat 1 1
type Scale "BWP" "thebe" Source # 
type Scale "BWP" "thebe" = (,) Nat Nat 100 1
type Scale "BYN" "BYN" Source # 
type Scale "BYN" "BYN" = (,) Nat Nat 100 1
type Scale "BYR" "BYR" Source # 
type Scale "BYR" "BYR" = (,) Nat Nat 100 1
type Scale "BYR" "kapyeyka" Source # 
type Scale "BYR" "kapyeyka" = (,) Nat Nat 100 1
type Scale "BYR" "ruble" Source # 
type Scale "BYR" "ruble" = (,) Nat Nat 1 1
type Scale "BZD" "BZD" Source # 
type Scale "BZD" "BZD" = (,) Nat Nat 100 1
type Scale "BZD" "cent" Source # 
type Scale "BZD" "cent" = (,) Nat Nat 100 1
type Scale "BZD" "dollar" Source # 
type Scale "BZD" "dollar" = (,) Nat Nat 1 1
type Scale "CAD" "CAD" Source # 
type Scale "CAD" "CAD" = (,) Nat Nat 100 1
type Scale "CAD" "cent" Source # 
type Scale "CAD" "cent" = (,) Nat Nat 100 1
type Scale "CAD" "dollar" Source # 
type Scale "CAD" "dollar" = (,) Nat Nat 1 1
type Scale "CDF" "CDF" Source # 
type Scale "CDF" "CDF" = (,) Nat Nat 100 1
type Scale "CDF" "centime" Source # 
type Scale "CDF" "centime" = (,) Nat Nat 100 1
type Scale "CDF" "franc" Source # 
type Scale "CDF" "franc" = (,) Nat Nat 1 1
type Scale "CHE" "CHE" Source # 
type Scale "CHE" "CHE" = (,) Nat Nat 100 1
type Scale "CHF" "CHF" Source # 
type Scale "CHF" "CHF" = (,) Nat Nat 100 1
type Scale "CHF" "franc" Source # 
type Scale "CHF" "franc" = (,) Nat Nat 1 1
type Scale "CHF" "rappen" Source # 
type Scale "CHF" "rappen" = (,) Nat Nat 100 1
type Scale "CHW" "CHW" Source # 
type Scale "CHW" "CHW" = (,) Nat Nat 100 1
type Scale "CLF" "CLF" Source # 
type Scale "CLF" "CLF" = (,) Nat Nat 100 1
type Scale "CLP" "CLP" Source # 
type Scale "CLP" "CLP" = (,) Nat Nat 100 1
type Scale "CLP" "centavo" Source # 
type Scale "CLP" "centavo" = (,) Nat Nat 100 1
type Scale "CLP" "peso" Source # 
type Scale "CLP" "peso" = (,) Nat Nat 1 1
type Scale "CNY" "CNY" Source # 
type Scale "CNY" "CNY" = (,) Nat Nat 100 1
type Scale "CNY" "fen" Source # 
type Scale "CNY" "fen" = (,) Nat Nat 100 1
type Scale "CNY" "yuan" Source # 
type Scale "CNY" "yuan" = (,) Nat Nat 1 1
type Scale "COP" "COP" Source # 
type Scale "COP" "COP" = (,) Nat Nat 100 1
type Scale "COP" "centavo" Source # 
type Scale "COP" "centavo" = (,) Nat Nat 100 1
type Scale "COP" "peso" Source # 
type Scale "COP" "peso" = (,) Nat Nat 1 1
type Scale "COU" "COU" Source # 
type Scale "COU" "COU" = (,) Nat Nat 100 1
type Scale "CRC" "CRC" Source # 
type Scale "CRC" "CRC" = (,) Nat Nat 100 1
type Scale "CRC" "centimo" Source # 
type Scale "CRC" "centimo" = (,) Nat Nat 100 1
type Scale "CRC" "colon" Source # 
type Scale "CRC" "colon" = (,) Nat Nat 1 1
type Scale "CUC" "CUC" Source # 
type Scale "CUC" "CUC" = (,) Nat Nat 100 1
type Scale "CUC" "centavo" Source # 
type Scale "CUC" "centavo" = (,) Nat Nat 100 1
type Scale "CUC" "peso" Source # 
type Scale "CUC" "peso" = (,) Nat Nat 1 1
type Scale "CUP" "CUP" Source # 
type Scale "CUP" "CUP" = (,) Nat Nat 100 1
type Scale "CUP" "centavo" Source # 
type Scale "CUP" "centavo" = (,) Nat Nat 100 1
type Scale "CUP" "peso" Source # 
type Scale "CUP" "peso" = (,) Nat Nat 1 1
type Scale "CVE" "CVE" Source # 
type Scale "CVE" "CVE" = (,) Nat Nat 100 1
type Scale "CVE" "centavo" Source # 
type Scale "CVE" "centavo" = (,) Nat Nat 100 1
type Scale "CVE" "escudo" Source # 
type Scale "CVE" "escudo" = (,) Nat Nat 1 1
type Scale "CZK" "CZK" Source # 
type Scale "CZK" "CZK" = (,) Nat Nat 100 1
type Scale "CZK" "haler" Source # 
type Scale "CZK" "haler" = (,) Nat Nat 100 1
type Scale "CZK" "koruna" Source # 
type Scale "CZK" "koruna" = (,) Nat Nat 1 1
type Scale "DJF" "DJF" Source # 
type Scale "DJF" "DJF" = (,) Nat Nat 100 1
type Scale "DJF" "centime" Source # 
type Scale "DJF" "centime" = (,) Nat Nat 100 1
type Scale "DJF" "franc" Source # 
type Scale "DJF" "franc" = (,) Nat Nat 1 1
type Scale "DKK" "DKK" Source # 
type Scale "DKK" "DKK" = (,) Nat Nat 100 1
type Scale "DKK" "krone" Source # 
type Scale "DKK" "krone" = (,) Nat Nat 1 1
type Scale "DKK" "ore" Source # 
type Scale "DKK" "ore" = (,) Nat Nat 100 1
type Scale "DOP" "DOP" Source # 
type Scale "DOP" "DOP" = (,) Nat Nat 100 1
type Scale "DOP" "centavo" Source # 
type Scale "DOP" "centavo" = (,) Nat Nat 100 1
type Scale "DOP" "peso" Source # 
type Scale "DOP" "peso" = (,) Nat Nat 1 1
type Scale "DZD" "DZD" Source # 
type Scale "DZD" "DZD" = (,) Nat Nat 100 1
type Scale "DZD" "dinar" Source # 
type Scale "DZD" "dinar" = (,) Nat Nat 1 1
type Scale "DZD" "santeem" Source # 
type Scale "DZD" "santeem" = (,) Nat Nat 100 1
type Scale "EGP" "EGP" Source # 
type Scale "EGP" "EGP" = (,) Nat Nat 100 1
type Scale "EGP" "piastre" Source # 
type Scale "EGP" "piastre" = (,) Nat Nat 100 1
type Scale "EGP" "pound" Source # 
type Scale "EGP" "pound" = (,) Nat Nat 1 1
type Scale "ERN" "ERN" Source # 
type Scale "ERN" "ERN" = (,) Nat Nat 100 1
type Scale "ERN" "cent" Source # 
type Scale "ERN" "cent" = (,) Nat Nat 100 1
type Scale "ERN" "nafka" Source # 
type Scale "ERN" "nafka" = (,) Nat Nat 1 1
type Scale "ETB" "ETB" Source # 
type Scale "ETB" "ETB" = (,) Nat Nat 100 1
type Scale "ETB" "birr" Source # 
type Scale "ETB" "birr" = (,) Nat Nat 1 1
type Scale "ETB" "santim" Source # 
type Scale "ETB" "santim" = (,) Nat Nat 100 1
type Scale "ETH" "ETH" Source # 
type Scale "ETH" "ETH" = (,) Nat Nat 1000000000000000000 1
type Scale "ETH" "babbage" Source # 
type Scale "ETH" "babbage" = (,) Nat Nat 1000 1
type Scale "ETH" "ether" Source # 
type Scale "ETH" "ether" = (,) Nat Nat 1 1
type Scale "ETH" "finney" Source # 
type Scale "ETH" "finney" = (,) Nat Nat 1000000000000000 1
type Scale "ETH" "gwei" Source # 
type Scale "ETH" "gwei" = (,) Nat Nat 1000000000 1
type Scale "ETH" "kwei" Source # 
type Scale "ETH" "kwei" = (,) Nat Nat 1000 1
type Scale "ETH" "lovelace" Source # 
type Scale "ETH" "lovelace" = (,) Nat Nat 1000000 1
type Scale "ETH" "microether" Source # 
type Scale "ETH" "microether" = (,) Nat Nat 1000000000000 1
type Scale "ETH" "milliether" Source # 
type Scale "ETH" "milliether" = (,) Nat Nat 1000000000000000 1
type Scale "ETH" "mwei" Source # 
type Scale "ETH" "mwei" = (,) Nat Nat 1000000 1
type Scale "ETH" "shannon" Source # 
type Scale "ETH" "shannon" = (,) Nat Nat 1000000000 1
type Scale "ETH" "szabo" Source # 
type Scale "ETH" "szabo" = (,) Nat Nat 1000000000000 1
type Scale "ETH" "wei" Source # 
type Scale "ETH" "wei" = (,) Nat Nat 1000000000000000000 1
type Scale "EUR" "EUR" Source # 
type Scale "EUR" "EUR" = (,) Nat Nat 100 1
type Scale "EUR" "cent" Source # 
type Scale "EUR" "cent" = (,) Nat Nat 100 1
type Scale "EUR" "euro" Source # 
type Scale "EUR" "euro" = (,) Nat Nat 1 1
type Scale "FJD" "FJD" Source # 
type Scale "FJD" "FJD" = (,) Nat Nat 100 1
type Scale "FKP" "FKP" Source # 
type Scale "FKP" "FKP" = (,) Nat Nat 100 1
type Scale "FKP" "penny" Source # 
type Scale "FKP" "penny" = (,) Nat Nat 100 1
type Scale "FKP" "pound" Source # 
type Scale "FKP" "pound" = (,) Nat Nat 1 1
type Scale "GBP" "GBP" Source # 
type Scale "GBP" "GBP" = (,) Nat Nat 100 1
type Scale "GBP" "penny" Source # 
type Scale "GBP" "penny" = (,) Nat Nat 100 1
type Scale "GBP" "pound" Source # 
type Scale "GBP" "pound" = (,) Nat Nat 1 1
type Scale "GEL" "GEL" Source # 
type Scale "GEL" "GEL" = (,) Nat Nat 100 1
type Scale "GEL" "lari" Source # 
type Scale "GEL" "lari" = (,) Nat Nat 1 1
type Scale "GEL" "tetri" Source # 
type Scale "GEL" "tetri" = (,) Nat Nat 100 1
type Scale "GHS" "GHS" Source # 
type Scale "GHS" "GHS" = (,) Nat Nat 100 1
type Scale "GHS" "cedi" Source # 
type Scale "GHS" "cedi" = (,) Nat Nat 1 1
type Scale "GHS" "pesewa" Source # 
type Scale "GHS" "pesewa" = (,) Nat Nat 100 1
type Scale "GIP" "GIP" Source # 
type Scale "GIP" "GIP" = (,) Nat Nat 100 1
type Scale "GIP" "penny" Source # 
type Scale "GIP" "penny" = (,) Nat Nat 100 1
type Scale "GIP" "pound" Source # 
type Scale "GIP" "pound" = (,) Nat Nat 1 1
type Scale "GMD" "GMD" Source # 
type Scale "GMD" "GMD" = (,) Nat Nat 100 1
type Scale "GMD" "butut" Source # 
type Scale "GMD" "butut" = (,) Nat Nat 100 1
type Scale "GMD" "dalasi" Source # 
type Scale "GMD" "dalasi" = (,) Nat Nat 1 1
type Scale "GNF" "GNF" Source # 
type Scale "GNF" "GNF" = (,) Nat Nat 100 1
type Scale "GNF" "centime" Source # 
type Scale "GNF" "centime" = (,) Nat Nat 100 1
type Scale "GNF" "franc" Source # 
type Scale "GNF" "franc" = (,) Nat Nat 1 1
type Scale "GTQ" "GTQ" Source # 
type Scale "GTQ" "GTQ" = (,) Nat Nat 100 1
type Scale "GTQ" "centavo" Source # 
type Scale "GTQ" "centavo" = (,) Nat Nat 100 1
type Scale "GTQ" "quetzal" Source # 
type Scale "GTQ" "quetzal" = (,) Nat Nat 1 1
type Scale "GYD" "GYD" Source # 
type Scale "GYD" "GYD" = (,) Nat Nat 100 1
type Scale "GYD" "cent" Source # 
type Scale "GYD" "cent" = (,) Nat Nat 100 1
type Scale "GYD" "dollar" Source # 
type Scale "GYD" "dollar" = (,) Nat Nat 1 1
type Scale "HKD" "HKD" Source # 
type Scale "HKD" "HKD" = (,) Nat Nat 100 1
type Scale "HKD" "cent" Source # 
type Scale "HKD" "cent" = (,) Nat Nat 100 1
type Scale "HKD" "dollar" Source # 
type Scale "HKD" "dollar" = (,) Nat Nat 1 1
type Scale "HNL" "HNL" Source # 
type Scale "HNL" "HNL" = (,) Nat Nat 100 1
type Scale "HNL" "centavo" Source # 
type Scale "HNL" "centavo" = (,) Nat Nat 100 1
type Scale "HNL" "lempira" Source # 
type Scale "HNL" "lempira" = (,) Nat Nat 1 1
type Scale "HRK" "HRK" Source # 
type Scale "HRK" "HRK" = (,) Nat Nat 100 1
type Scale "HRK" "kuna" Source # 
type Scale "HRK" "kuna" = (,) Nat Nat 1 1
type Scale "HRK" "lipa" Source # 
type Scale "HRK" "lipa" = (,) Nat Nat 100 1
type Scale "HTG" "HTG" Source # 
type Scale "HTG" "HTG" = (,) Nat Nat 100 1
type Scale "HTG" "centime" Source # 
type Scale "HTG" "centime" = (,) Nat Nat 1 1
type Scale "HTG" "gourde" Source # 
type Scale "HTG" "gourde" = (,) Nat Nat 1 1
type Scale "HUF" "HUF" Source # 
type Scale "HUF" "HUF" = (,) Nat Nat 100 1
type Scale "HUF" "filler" Source # 
type Scale "HUF" "filler" = (,) Nat Nat 100 1
type Scale "HUF" "forint" Source # 
type Scale "HUF" "forint" = (,) Nat Nat 1 1
type Scale "IDR" "IDR" Source # 
type Scale "IDR" "IDR" = (,) Nat Nat 100 1
type Scale "IDR" "rupiah" Source # 
type Scale "IDR" "rupiah" = (,) Nat Nat 1 1
type Scale "IDR" "sen" Source # 
type Scale "IDR" "sen" = (,) Nat Nat 100 1
type Scale "ILS" "ILS" Source # 
type Scale "ILS" "ILS" = (,) Nat Nat 100 1
type Scale "ILS" "agora" Source # 
type Scale "ILS" "agora" = (,) Nat Nat 100 1
type Scale "ILS" "shekel" Source # 
type Scale "ILS" "shekel" = (,) Nat Nat 1 1
type Scale "INR" "INR" Source # 
type Scale "INR" "INR" = (,) Nat Nat 100 1
type Scale "INR" "paisa" Source # 
type Scale "INR" "paisa" = (,) Nat Nat 100 1
type Scale "INR" "rupee" Source # 
type Scale "INR" "rupee" = (,) Nat Nat 1 1
type Scale "IQD" "IQD" Source # 
type Scale "IQD" "IQD" = (,) Nat Nat 1000 1
type Scale "IQD" "dinar" Source # 
type Scale "IQD" "dinar" = (,) Nat Nat 1 1
type Scale "IQD" "fils" Source # 
type Scale "IQD" "fils" = (,) Nat Nat 1000 1
type Scale "IRR" "IRR" Source # 
type Scale "IRR" "IRR" = (,) Nat Nat 100 1
type Scale "IRR" "dinar" Source # 
type Scale "IRR" "dinar" = (,) Nat Nat 100 1
type Scale "IRR" "rial" Source # 
type Scale "IRR" "rial" = (,) Nat Nat 1 1
type Scale "ISK" "ISK" Source # 
type Scale "ISK" "ISK" = (,) Nat Nat 100 1
type Scale "ISK" "eyir" Source # 
type Scale "ISK" "eyir" = (,) Nat Nat 100 1
type Scale "ISK" "krona" Source # 
type Scale "ISK" "krona" = (,) Nat Nat 1 1
type Scale "JMD" "JMD" Source # 
type Scale "JMD" "JMD" = (,) Nat Nat 100 1
type Scale "JMD" "cent" Source # 
type Scale "JMD" "cent" = (,) Nat Nat 100 1
type Scale "JMD" "dollar" Source # 
type Scale "JMD" "dollar" = (,) Nat Nat 1 1
type Scale "JOD" "JOD" Source # 
type Scale "JOD" "JOD" = (,) Nat Nat 100 1
type Scale "JOD" "dinar" Source # 
type Scale "JOD" "dinar" = (,) Nat Nat 1 1
type Scale "JOD" "piastre" Source # 
type Scale "JOD" "piastre" = (,) Nat Nat 100 1
type Scale "JPY" "JPY" Source # 
type Scale "JPY" "JPY" = (,) Nat Nat 100 1
type Scale "JPY" "sen" Source # 
type Scale "JPY" "sen" = (,) Nat Nat 100 1
type Scale "JPY" "yen" Source # 
type Scale "JPY" "yen" = (,) Nat Nat 1 1
type Scale "KES" "KES" Source # 
type Scale "KES" "KES" = (,) Nat Nat 100 1
type Scale "KES" "cent" Source # 
type Scale "KES" "cent" = (,) Nat Nat 100 1
type Scale "KES" "shilling" Source # 
type Scale "KES" "shilling" = (,) Nat Nat 1 1
type Scale "KGS" "KGS" Source # 
type Scale "KGS" "KGS" = (,) Nat Nat 100 1
type Scale "KGS" "som" Source # 
type Scale "KGS" "som" = (,) Nat Nat 1 1
type Scale "KGS" "tyiyn" Source # 
type Scale "KGS" "tyiyn" = (,) Nat Nat 100 1
type Scale "KHR" "KHR" Source # 
type Scale "KHR" "KHR" = (,) Nat Nat 100 1
type Scale "KHR" "riel" Source # 
type Scale "KHR" "riel" = (,) Nat Nat 1 1
type Scale "KHR" "sen" Source # 
type Scale "KHR" "sen" = (,) Nat Nat 100 1
type Scale "KMF" "KMF" Source # 
type Scale "KMF" "KMF" = (,) Nat Nat 100 1
type Scale "KMF" "centime" Source # 
type Scale "KMF" "centime" = (,) Nat Nat 100 1
type Scale "KMF" "franc" Source # 
type Scale "KMF" "franc" = (,) Nat Nat 1 1
type Scale "KPW" "KPW" Source # 
type Scale "KPW" "KPW" = (,) Nat Nat 100 1
type Scale "KPW" "chon" Source # 
type Scale "KPW" "chon" = (,) Nat Nat 100 1
type Scale "KPW" "won" Source # 
type Scale "KPW" "won" = (,) Nat Nat 1 1
type Scale "KRW" "KRW" Source # 
type Scale "KRW" "KRW" = (,) Nat Nat 100 1
type Scale "KRW" "jeon" Source # 
type Scale "KRW" "jeon" = (,) Nat Nat 100 1
type Scale "KRW" "won" Source # 
type Scale "KRW" "won" = (,) Nat Nat 1 1
type Scale "KWD" "KWD" Source # 
type Scale "KWD" "KWD" = (,) Nat Nat 1000 1
type Scale "KWD" "dinar" Source # 
type Scale "KWD" "dinar" = (,) Nat Nat 1 1
type Scale "KWD" "fils" Source # 
type Scale "KWD" "fils" = (,) Nat Nat 1000 1
type Scale "KYD" "KYD" Source # 
type Scale "KYD" "KYD" = (,) Nat Nat 100 1
type Scale "KYD" "cent" Source # 
type Scale "KYD" "cent" = (,) Nat Nat 100 1
type Scale "KYD" "dollar" Source # 
type Scale "KYD" "dollar" = (,) Nat Nat 1 1
type Scale "KZT" "KZT" Source # 
type Scale "KZT" "KZT" = (,) Nat Nat 100 1
type Scale "KZT" "tenge" Source # 
type Scale "KZT" "tenge" = (,) Nat Nat 1 1
type Scale "KZT" "tiyin" Source # 
type Scale "KZT" "tiyin" = (,) Nat Nat 100 1
type Scale "LAK" "LAK" Source # 
type Scale "LAK" "LAK" = (,) Nat Nat 100 1
type Scale "LAK" "att" Source # 
type Scale "LAK" "att" = (,) Nat Nat 100 1
type Scale "LAK" "kip" Source # 
type Scale "LAK" "kip" = (,) Nat Nat 1 1
type Scale "LBP" "LBP" Source # 
type Scale "LBP" "LBP" = (,) Nat Nat 100 1
type Scale "LBP" "piastre" Source # 
type Scale "LBP" "piastre" = (,) Nat Nat 100 1
type Scale "LBP" "pound" Source # 
type Scale "LBP" "pound" = (,) Nat Nat 1 1
type Scale "LKR" "LKR" Source # 
type Scale "LKR" "LKR" = (,) Nat Nat 100 1
type Scale "LKR" "cent" Source # 
type Scale "LKR" "cent" = (,) Nat Nat 100 1
type Scale "LKR" "rupee" Source # 
type Scale "LKR" "rupee" = (,) Nat Nat 1 1
type Scale "LRD" "LRD" Source # 
type Scale "LRD" "LRD" = (,) Nat Nat 100 1
type Scale "LRD" "cent" Source # 
type Scale "LRD" "cent" = (,) Nat Nat 100 1
type Scale "LRD" "dollar" Source # 
type Scale "LRD" "dollar" = (,) Nat Nat 1 1
type Scale "LSL" "LSL" Source # 
type Scale "LSL" "LSL" = (,) Nat Nat 100 1
type Scale "LSL" "loti" Source # 
type Scale "LSL" "loti" = (,) Nat Nat 1 1
type Scale "LSL" "sente" Source # 
type Scale "LSL" "sente" = (,) Nat Nat 100 1
type Scale "LYD" "LYD" Source # 
type Scale "LYD" "LYD" = (,) Nat Nat 100 1
type Scale "LYD" "dinar" Source # 
type Scale "LYD" "dinar" = (,) Nat Nat 1 1
type Scale "LYD" "dirham" Source # 
type Scale "LYD" "dirham" = (,) Nat Nat 1000 1
type Scale "MAD" "MAD" Source # 
type Scale "MAD" "MAD" = (,) Nat Nat 100 1
type Scale "MAD" "centime" Source # 
type Scale "MAD" "centime" = (,) Nat Nat 100 1
type Scale "MAD" "dirham" Source # 
type Scale "MAD" "dirham" = (,) Nat Nat 1 1
type Scale "MDL" "MDL" Source # 
type Scale "MDL" "MDL" = (,) Nat Nat 100 1
type Scale "MDL" "ban" Source # 
type Scale "MDL" "ban" = (,) Nat Nat 100 1
type Scale "MDL" "leu" Source # 
type Scale "MDL" "leu" = (,) Nat Nat 100 1
type Scale "MGA" "MGA" Source # 
type Scale "MGA" "MGA" = (,) Nat Nat 5 1
type Scale "MGA" "ariary" Source # 
type Scale "MGA" "ariary" = (,) Nat Nat 1 1
type Scale "MGA" "iraimbilanja" Source # 
type Scale "MGA" "iraimbilanja" = (,) Nat Nat 5 1
type Scale "MKD" "MKD" Source # 
type Scale "MKD" "MKD" = (,) Nat Nat 100 1
type Scale "MKD" "denar" Source # 
type Scale "MKD" "denar" = (,) Nat Nat 1 1
type Scale "MKD" "deni" Source # 
type Scale "MKD" "deni" = (,) Nat Nat 100 1
type Scale "MMK" "MMK" Source # 
type Scale "MMK" "MMK" = (,) Nat Nat 100 1
type Scale "MMK" "kyat" Source # 
type Scale "MMK" "kyat" = (,) Nat Nat 1 1
type Scale "MMK" "pya" Source # 
type Scale "MMK" "pya" = (,) Nat Nat 100 1
type Scale "MNT" "MNT" Source # 
type Scale "MNT" "MNT" = (,) Nat Nat 100 1
type Scale "MNT" "mongo" Source # 
type Scale "MNT" "mongo" = (,) Nat Nat 100 1
type Scale "MNT" "tugrik" Source # 
type Scale "MNT" "tugrik" = (,) Nat Nat 1 1
type Scale "MOP" "MOP" Source # 
type Scale "MOP" "MOP" = (,) Nat Nat 100 1
type Scale "MOP" "avo" Source # 
type Scale "MOP" "avo" = (,) Nat Nat 100 1
type Scale "MOP" "pataca" Source # 
type Scale "MOP" "pataca" = (,) Nat Nat 1 1
type Scale "MRO" "MRO" Source # 
type Scale "MRO" "MRO" = (,) Nat Nat 5 1
type Scale "MRO" "khoums" Source # 
type Scale "MRO" "khoums" = (,) Nat Nat 5 1
type Scale "MRO" "ouguiya" Source # 
type Scale "MRO" "ouguiya" = (,) Nat Nat 1 1
type Scale "MUR" "MUR" Source # 
type Scale "MUR" "MUR" = (,) Nat Nat 100 1
type Scale "MUR" "cent" Source # 
type Scale "MUR" "cent" = (,) Nat Nat 100 1
type Scale "MUR" "rupee" Source # 
type Scale "MUR" "rupee" = (,) Nat Nat 1 1
type Scale "MVR" "MVR" Source # 
type Scale "MVR" "MVR" = (,) Nat Nat 100 1
type Scale "MVR" "laari" Source # 
type Scale "MVR" "laari" = (,) Nat Nat 100 1
type Scale "MVR" "rufiyaa" Source # 
type Scale "MVR" "rufiyaa" = (,) Nat Nat 1 1
type Scale "MWK" "MWK" Source # 
type Scale "MWK" "MWK" = (,) Nat Nat 100 1
type Scale "MWK" "kwacha" Source # 
type Scale "MWK" "kwacha" = (,) Nat Nat 1 1
type Scale "MWK" "tambala" Source # 
type Scale "MWK" "tambala" = (,) Nat Nat 100 1
type Scale "MXN" "MXN" Source # 
type Scale "MXN" "MXN" = (,) Nat Nat 100 1
type Scale "MXN" "centavo" Source # 
type Scale "MXN" "centavo" = (,) Nat Nat 100 1
type Scale "MXN" "peso" Source # 
type Scale "MXN" "peso" = (,) Nat Nat 1 1
type Scale "MXV" "MXV" Source # 
type Scale "MXV" "MXV" = (,) Nat Nat 100 1
type Scale "MYR" "MYR" Source # 
type Scale "MYR" "MYR" = (,) Nat Nat 100 1
type Scale "MYR" "ringgit" Source # 
type Scale "MYR" "ringgit" = (,) Nat Nat 1 1
type Scale "MYR" "sen" Source # 
type Scale "MYR" "sen" = (,) Nat Nat 100 1
type Scale "MZN" "MZN" Source # 
type Scale "MZN" "MZN" = (,) Nat Nat 100 1
type Scale "MZN" "centavo" Source # 
type Scale "MZN" "centavo" = (,) Nat Nat 100 1
type Scale "MZN" "metical" Source # 
type Scale "MZN" "metical" = (,) Nat Nat 1 1
type Scale "NAD" "NAD" Source # 
type Scale "NAD" "NAD" = (,) Nat Nat 100 1
type Scale "NAD" "cent" Source # 
type Scale "NAD" "cent" = (,) Nat Nat 100 1
type Scale "NAD" "dollar" Source # 
type Scale "NAD" "dollar" = (,) Nat Nat 1 1
type Scale "NGN" "NGN" Source # 
type Scale "NGN" "NGN" = (,) Nat Nat 100 1
type Scale "NGN" "kobo" Source # 
type Scale "NGN" "kobo" = (,) Nat Nat 100 1
type Scale "NGN" "naira" Source # 
type Scale "NGN" "naira" = (,) Nat Nat 1 1
type Scale "NIO" "NIO" Source # 
type Scale "NIO" "NIO" = (,) Nat Nat 100 1
type Scale "NIO" "centavo" Source # 
type Scale "NIO" "centavo" = (,) Nat Nat 100 1
type Scale "NIO" "cordoba" Source # 
type Scale "NIO" "cordoba" = (,) Nat Nat 1 1
type Scale "NOK" "NOK" Source # 
type Scale "NOK" "NOK" = (,) Nat Nat 100 1
type Scale "NOK" "krone" Source # 
type Scale "NOK" "krone" = (,) Nat Nat 1 1
type Scale "NOK" "ore" Source # 
type Scale "NOK" "ore" = (,) Nat Nat 100 1
type Scale "NPR" "NPR" Source # 
type Scale "NPR" "NPR" = (,) Nat Nat 100 1
type Scale "NPR" "paisa" Source # 
type Scale "NPR" "paisa" = (,) Nat Nat 100 1
type Scale "NPR" "rupee" Source # 
type Scale "NPR" "rupee" = (,) Nat Nat 1 1
type Scale "NZD" "NZD" Source # 
type Scale "NZD" "NZD" = (,) Nat Nat 100 1
type Scale "NZD" "cent" Source # 
type Scale "NZD" "cent" = (,) Nat Nat 100 1
type Scale "NZD" "dollar" Source # 
type Scale "NZD" "dollar" = (,) Nat Nat 1 1
type Scale "OMR" "OMR" Source # 
type Scale "OMR" "OMR" = (,) Nat Nat 1000 1
type Scale "OMR" "baisa" Source # 
type Scale "OMR" "baisa" = (,) Nat Nat 1000 1
type Scale "OMR" "rial" Source # 
type Scale "OMR" "rial" = (,) Nat Nat 1 1
type Scale "PAB" "PAB" Source # 
type Scale "PAB" "PAB" = (,) Nat Nat 100 1
type Scale "PAB" "balboa" Source # 
type Scale "PAB" "balboa" = (,) Nat Nat 1 1
type Scale "PAB" "centesimo" Source # 
type Scale "PAB" "centesimo" = (,) Nat Nat 100 1
type Scale "PEN" "PEN" Source # 
type Scale "PEN" "PEN" = (,) Nat Nat 100 1
type Scale "PEN" "centimo" Source # 
type Scale "PEN" "centimo" = (,) Nat Nat 100 1
type Scale "PEN" "sol" Source # 
type Scale "PEN" "sol" = (,) Nat Nat 1 1
type Scale "PGK" "PGK" Source # 
type Scale "PGK" "PGK" = (,) Nat Nat 100 1
type Scale "PGK" "kina" Source # 
type Scale "PGK" "kina" = (,) Nat Nat 1 1
type Scale "PGK" "toea" Source # 
type Scale "PGK" "toea" = (,) Nat Nat 100 1
type Scale "PHP" "PHP" Source # 
type Scale "PHP" "PHP" = (,) Nat Nat 100 1
type Scale "PHP" "centavo" Source # 
type Scale "PHP" "centavo" = (,) Nat Nat 100 1
type Scale "PHP" "peso" Source # 
type Scale "PHP" "peso" = (,) Nat Nat 1 1
type Scale "PKR" "PKR" Source # 
type Scale "PKR" "PKR" = (,) Nat Nat 100 1
type Scale "PKR" "paisa" Source # 
type Scale "PKR" "paisa" = (,) Nat Nat 100 1
type Scale "PKR" "rupee" Source # 
type Scale "PKR" "rupee" = (,) Nat Nat 1 1
type Scale "PLN" "PLN" Source # 
type Scale "PLN" "PLN" = (,) Nat Nat 100 1
type Scale "PLN" "grosz" Source # 
type Scale "PLN" "grosz" = (,) Nat Nat 100 1
type Scale "PLN" "zloty" Source # 
type Scale "PLN" "zloty" = (,) Nat Nat 1 1
type Scale "PYG" "PYG" Source # 
type Scale "PYG" "PYG" = (,) Nat Nat 100 1
type Scale "PYG" "centimo" Source # 
type Scale "PYG" "centimo" = (,) Nat Nat 100 1
type Scale "PYG" "guarani" Source # 
type Scale "PYG" "guarani" = (,) Nat Nat 1 1
type Scale "QAR" "QAR" Source # 
type Scale "QAR" "QAR" = (,) Nat Nat 100 1
type Scale "QAR" "dirham" Source # 
type Scale "QAR" "dirham" = (,) Nat Nat 100 1
type Scale "QAR" "riyal" Source # 
type Scale "QAR" "riyal" = (,) Nat Nat 1 1
type Scale "RON" "RON" Source # 
type Scale "RON" "RON" = (,) Nat Nat 100 1
type Scale "RON" "ban" Source # 
type Scale "RON" "ban" = (,) Nat Nat 100 1
type Scale "RON" "leu" Source # 
type Scale "RON" "leu" = (,) Nat Nat 1 1
type Scale "RSD" "RSD" Source # 
type Scale "RSD" "RSD" = (,) Nat Nat 100 1
type Scale "RSD" "dinar" Source # 
type Scale "RSD" "dinar" = (,) Nat Nat 1 1
type Scale "RSD" "para" Source # 
type Scale "RSD" "para" = (,) Nat Nat 100 1
type Scale "RUB" "RUB" Source # 
type Scale "RUB" "RUB" = (,) Nat Nat 100 1
type Scale "RUB" "kopek" Source # 
type Scale "RUB" "kopek" = (,) Nat Nat 100 1
type Scale "RUB" "ruble" Source # 
type Scale "RUB" "ruble" = (,) Nat Nat 1 1
type Scale "RWF" "RWF" Source # 
type Scale "RWF" "RWF" = (,) Nat Nat 100 1
type Scale "RWF" "centime" Source # 
type Scale "RWF" "centime" = (,) Nat Nat 100 1
type Scale "RWF" "franc" Source # 
type Scale "RWF" "franc" = (,) Nat Nat 1 1
type Scale "SAR" "SAR" Source # 
type Scale "SAR" "SAR" = (,) Nat Nat 100 1
type Scale "SAR" "halala" Source # 
type Scale "SAR" "halala" = (,) Nat Nat 100 1
type Scale "SAR" "riyal" Source # 
type Scale "SAR" "riyal" = (,) Nat Nat 1 1
type Scale "SBD" "SBD" Source # 
type Scale "SBD" "SBD" = (,) Nat Nat 100 1
type Scale "SBD" "cent" Source # 
type Scale "SBD" "cent" = (,) Nat Nat 100 1
type Scale "SBD" "dollar" Source # 
type Scale "SBD" "dollar" = (,) Nat Nat 100 1
type Scale "SCR" "SCR" Source # 
type Scale "SCR" "SCR" = (,) Nat Nat 100 1
type Scale "SCR" "cent" Source # 
type Scale "SCR" "cent" = (,) Nat Nat 100 1
type Scale "SCR" "rupee" Source # 
type Scale "SCR" "rupee" = (,) Nat Nat 1 1
type Scale "SDG" "SDG" Source # 
type Scale "SDG" "SDG" = (,) Nat Nat 100 1
type Scale "SDG" "piastre" Source # 
type Scale "SDG" "piastre" = (,) Nat Nat 100 1
type Scale "SDG" "pound" Source # 
type Scale "SDG" "pound" = (,) Nat Nat 1 1
type Scale "SEK" "SEK" Source # 
type Scale "SEK" "SEK" = (,) Nat Nat 100 1
type Scale "SEK" "krona" Source # 
type Scale "SEK" "krona" = (,) Nat Nat 1 1
type Scale "SEK" "ore" Source # 
type Scale "SEK" "ore" = (,) Nat Nat 100 1
type Scale "SGD" "SGD" Source # 
type Scale "SGD" "SGD" = (,) Nat Nat 100 1
type Scale "SGD" "cent" Source # 
type Scale "SGD" "cent" = (,) Nat Nat 100 1
type Scale "SGD" "dollar" Source # 
type Scale "SGD" "dollar" = (,) Nat Nat 1 1
type Scale "SHP" "SHP" Source # 
type Scale "SHP" "SHP" = (,) Nat Nat 100 1
type Scale "SHP" "penny" Source # 
type Scale "SHP" "penny" = (,) Nat Nat 100 1
type Scale "SHP" "pound" Source # 
type Scale "SHP" "pound" = (,) Nat Nat 1 1
type Scale "SLL" "SLL" Source # 
type Scale "SLL" "SLL" = (,) Nat Nat 100 1
type Scale "SLL" "cent" Source # 
type Scale "SLL" "cent" = (,) Nat Nat 100 1
type Scale "SLL" "leone" Source # 
type Scale "SLL" "leone" = (,) Nat Nat 1 1
type Scale "SOS" "SOS" Source # 
type Scale "SOS" "SOS" = (,) Nat Nat 100 1
type Scale "SOS" "cent" Source # 
type Scale "SOS" "cent" = (,) Nat Nat 100 1
type Scale "SOS" "shilling" Source # 
type Scale "SOS" "shilling" = (,) Nat Nat 1 1
type Scale "SRD" "SRD" Source # 
type Scale "SRD" "SRD" = (,) Nat Nat 100 1
type Scale "SRD" "cent" Source # 
type Scale "SRD" "cent" = (,) Nat Nat 100 1
type Scale "SRD" "dollar" Source # 
type Scale "SRD" "dollar" = (,) Nat Nat 1 1
type Scale "SSP" "SSP" Source # 
type Scale "SSP" "SSP" = (,) Nat Nat 100 1
type Scale "SSP" "piastre" Source # 
type Scale "SSP" "piastre" = (,) Nat Nat 100 1
type Scale "SSP" "pound" Source # 
type Scale "SSP" "pound" = (,) Nat Nat 1 1
type Scale "STD" "STD" Source # 
type Scale "STD" "STD" = (,) Nat Nat 100 1
type Scale "STD" "centimo" Source # 
type Scale "STD" "centimo" = (,) Nat Nat 100 1
type Scale "STD" "dobra" Source # 
type Scale "STD" "dobra" = (,) Nat Nat 1 1
type Scale "SVC" "SVC" Source # 
type Scale "SVC" "SVC" = (,) Nat Nat 100 1
type Scale "SVC" "centavo" Source # 
type Scale "SVC" "centavo" = (,) Nat Nat 100 1
type Scale "SVC" "colon" Source # 
type Scale "SVC" "colon" = (,) Nat Nat 1 1
type Scale "SYP" "SYP" Source # 
type Scale "SYP" "SYP" = (,) Nat Nat 100 1
type Scale "SYP" "piastre" Source # 
type Scale "SYP" "piastre" = (,) Nat Nat 100 1
type Scale "SYP" "pound" Source # 
type Scale "SYP" "pound" = (,) Nat Nat 1 1
type Scale "SZL" "SZL" Source # 
type Scale "SZL" "SZL" = (,) Nat Nat 100 1
type Scale "SZL" "cent" Source # 
type Scale "SZL" "cent" = (,) Nat Nat 100 1
type Scale "SZL" "lilangeni" Source # 
type Scale "SZL" "lilangeni" = (,) Nat Nat 1 1
type Scale "THB" "THB" Source # 
type Scale "THB" "THB" = (,) Nat Nat 100 1
type Scale "THB" "baht" Source # 
type Scale "THB" "baht" = (,) Nat Nat 1 1
type Scale "THB" "satang" Source # 
type Scale "THB" "satang" = (,) Nat Nat 100 1
type Scale "TJS" "TJS" Source # 
type Scale "TJS" "TJS" = (,) Nat Nat 100 1
type Scale "TJS" "diram" Source # 
type Scale "TJS" "diram" = (,) Nat Nat 100 1
type Scale "TJS" "somoni" Source # 
type Scale "TJS" "somoni" = (,) Nat Nat 1 1
type Scale "TMT" "TMT" Source # 
type Scale "TMT" "TMT" = (,) Nat Nat 100 1
type Scale "TMT" "manat" Source # 
type Scale "TMT" "manat" = (,) Nat Nat 1 1
type Scale "TMT" "tennesi" Source # 
type Scale "TMT" "tennesi" = (,) Nat Nat 100 1
type Scale "TND" "TND" Source # 
type Scale "TND" "TND" = (,) Nat Nat 1000 1
type Scale "TND" "dinar" Source # 
type Scale "TND" "dinar" = (,) Nat Nat 1 1
type Scale "TND" "millime" Source # 
type Scale "TND" "millime" = (,) Nat Nat 1000 1
type Scale "TOP" "TOP" Source # 
type Scale "TOP" "TOP" = (,) Nat Nat 100 1
type Scale "TOP" "pa'anga" Source # 
type Scale "TOP" "pa'anga" = (,) Nat Nat 1 1
type Scale "TOP" "seniti" Source # 
type Scale "TOP" "seniti" = (,) Nat Nat 100 1
type Scale "TRY" "TRY" Source # 
type Scale "TRY" "TRY" = (,) Nat Nat 100 1
type Scale "TRY" "kurus" Source # 
type Scale "TRY" "kurus" = (,) Nat Nat 100 1
type Scale "TRY" "lira" Source # 
type Scale "TRY" "lira" = (,) Nat Nat 1 1
type Scale "TTD" "TTD" Source # 
type Scale "TTD" "TTD" = (,) Nat Nat 100 1
type Scale "TTD" "cent" Source # 
type Scale "TTD" "cent" = (,) Nat Nat 100 1
type Scale "TTD" "dollar" Source # 
type Scale "TTD" "dollar" = (,) Nat Nat 1 1
type Scale "TWD" "TWD" Source # 
type Scale "TWD" "TWD" = (,) Nat Nat 100 1
type Scale "TWD" "cent" Source # 
type Scale "TWD" "cent" = (,) Nat Nat 100 1
type Scale "TWD" "dollar" Source # 
type Scale "TWD" "dollar" = (,) Nat Nat 1 1
type Scale "TZS" "TZS" Source # 
type Scale "TZS" "TZS" = (,) Nat Nat 100 1
type Scale "TZS" "cent" Source # 
type Scale "TZS" "cent" = (,) Nat Nat 100 1
type Scale "TZS" "shilling" Source # 
type Scale "TZS" "shilling" = (,) Nat Nat 1 1
type Scale "UAH" "UAH" Source # 
type Scale "UAH" "UAH" = (,) Nat Nat 100 1
type Scale "UAH" "hryvnia" Source # 
type Scale "UAH" "hryvnia" = (,) Nat Nat 1 1
type Scale "UAH" "kopiyka" Source # 
type Scale "UAH" "kopiyka" = (,) Nat Nat 100 1
type Scale "UGX" "UGX" Source # 
type Scale "UGX" "UGX" = (,) Nat Nat 100 1
type Scale "UGX" "cent" Source # 
type Scale "UGX" "cent" = (,) Nat Nat 100 1
type Scale "UGX" "shilling" Source # 
type Scale "UGX" "shilling" = (,) Nat Nat 1 1
type Scale "USD" "USD" Source # 
type Scale "USD" "USD" = (,) Nat Nat 100 1
type Scale "USD" "cent" Source # 
type Scale "USD" "cent" = (,) Nat Nat 100 1
type Scale "USD" "dollar" Source # 
type Scale "USD" "dollar" = (,) Nat Nat 1 1
type Scale "USN" "USN" Source # 
type Scale "USN" "USN" = (,) Nat Nat 100 1
type Scale "UYI" "UYI" Source # 
type Scale "UYI" "UYI" = (,) Nat Nat 100 1
type Scale "UYU" "UYU" Source # 
type Scale "UYU" "UYU" = (,) Nat Nat 100 1
type Scale "UYU" "centesimo" Source # 
type Scale "UYU" "centesimo" = (,) Nat Nat 100 1
type Scale "UYU" "peso" Source # 
type Scale "UYU" "peso" = (,) Nat Nat 1 1
type Scale "UZS" "UZS" Source # 
type Scale "UZS" "UZS" = (,) Nat Nat 100 1
type Scale "UZS" "som" Source # 
type Scale "UZS" "som" = (,) Nat Nat 1 1
type Scale "UZS" "tiyin" Source # 
type Scale "UZS" "tiyin" = (,) Nat Nat 100 1
type Scale "VEF" "VEF" Source # 
type Scale "VEF" "VEF" = (,) Nat Nat 100 1
type Scale "VEF" "bolivar" Source # 
type Scale "VEF" "bolivar" = (,) Nat Nat 1 1
type Scale "VEF" "centimo" Source # 
type Scale "VEF" "centimo" = (,) Nat Nat 100 1
type Scale "VND" "VND" Source # 
type Scale "VND" "VND" = (,) Nat Nat 10 1
type Scale "VND" "dong" Source # 
type Scale "VND" "dong" = (,) Nat Nat 1 1
type Scale "VND" "hao" Source # 
type Scale "VND" "hao" = (,) Nat Nat 10 1
type Scale "VUV" "VUV" Source # 
type Scale "VUV" "VUV" = (,) Nat Nat 1 1
type Scale "VUV" "vatu" Source # 
type Scale "VUV" "vatu" = (,) Nat Nat 1 1
type Scale "WST" "WST" Source # 
type Scale "WST" "WST" = (,) Nat Nat 100 1
type Scale "WST" "sene" Source # 
type Scale "WST" "sene" = (,) Nat Nat 100 1
type Scale "WST" "tala" Source # 
type Scale "WST" "tala" = (,) Nat Nat 1 1
type Scale "XAF" "XAF" Source # 
type Scale "XAF" "XAF" = (,) Nat Nat 100 1
type Scale "XAF" "centime" Source # 
type Scale "XAF" "centime" = (,) Nat Nat 100 1
type Scale "XAF" "franc" Source # 
type Scale "XAF" "franc" = (,) Nat Nat 1 1
type Scale "XAG" "XAG" Source # 
type Scale "XAG" "XAG" = ErrScaleNonCanonical (Nat, Nat) "XAG"
type Scale "XAG" "grain" Source # 
type Scale "XAG" "grain" = (,) Nat Nat 480 1
type Scale "XAG" "gram" Source # 
type Scale "XAG" "gram" = (,) Nat Nat 31103477 1000000
type Scale "XAG" "kilogram" Source # 
type Scale "XAG" "kilogram" = (,) Nat Nat 31103477 1000000000
type Scale "XAG" "micrograin" Source # 
type Scale "XAG" "micrograin" = (,) Nat Nat 480000000 1
type Scale "XAG" "microgram" Source # 
type Scale "XAG" "microgram" = (,) Nat Nat 31103477 1
type Scale "XAG" "milligrain" Source # 
type Scale "XAG" "milligrain" = (,) Nat Nat 480000 1
type Scale "XAG" "milligram" Source # 
type Scale "XAG" "milligram" = (,) Nat Nat 31103477 1000
type Scale "XAG" "troy-ounce" Source # 
type Scale "XAG" "troy-ounce" = (,) Nat Nat 1 1
type Scale "XAU" "XAU" Source # 
type Scale "XAU" "XAU" = ErrScaleNonCanonical (Nat, Nat) "XAU"
type Scale "XAU" "grain" Source # 
type Scale "XAU" "grain" = (,) Nat Nat 480 1
type Scale "XAU" "gram" Source # 
type Scale "XAU" "gram" = (,) Nat Nat 31103477 1000000
type Scale "XAU" "kilogram" Source # 
type Scale "XAU" "kilogram" = (,) Nat Nat 31103477 1000000000
type Scale "XAU" "micrograin" Source # 
type Scale "XAU" "micrograin" = (,) Nat Nat 480000000 1
type Scale "XAU" "microgram" Source # 
type Scale "XAU" "microgram" = (,) Nat Nat 31103477 1
type Scale "XAU" "milligrain" Source # 
type Scale "XAU" "milligrain" = (,) Nat Nat 480000 1
type Scale "XAU" "milligram" Source # 
type Scale "XAU" "milligram" = (,) Nat Nat 31103477 1000
type Scale "XAU" "troy-ounce" Source # 
type Scale "XAU" "troy-ounce" = (,) Nat Nat 1 1
type Scale "XBT" "XBT" Source # 
type Scale "XBT" "XBT" = (,) Nat Nat 100000000 1
type Scale "XBT" "bitcoin" Source # 
type Scale "XBT" "bitcoin" = (,) Nat Nat 1 1
type Scale "XBT" "satoshi" Source # 
type Scale "XBT" "satoshi" = (,) Nat Nat 100000000 1
type Scale "XCD" "XCD" Source # 
type Scale "XCD" "XCD" = (,) Nat Nat 100 1
type Scale "XCD" "cent" Source # 
type Scale "XCD" "cent" = (,) Nat Nat 100 1
type Scale "XCD" "dollar" Source # 
type Scale "XCD" "dollar" = (,) Nat Nat 1 1
type Scale "XDR" "XDR" Source # 
type Scale "XDR" "XDR" = (,) Nat Nat 100 1
type Scale "XOF" "XOF" Source # 
type Scale "XOF" "XOF" = (,) Nat Nat 100 1
type Scale "XOF" "centime" Source # 
type Scale "XOF" "centime" = (,) Nat Nat 100 1
type Scale "XOF" "franc" Source # 
type Scale "XOF" "franc" = (,) Nat Nat 1 1
type Scale "XPD" "XPD" Source # 
type Scale "XPD" "XPD" = ErrScaleNonCanonical (Nat, Nat) "XPD"
type Scale "XPD" "grain" Source # 
type Scale "XPD" "grain" = (,) Nat Nat 480 1
type Scale "XPD" "gram" Source # 
type Scale "XPD" "gram" = (,) Nat Nat 31103477 1000000
type Scale "XPD" "kilogram" Source # 
type Scale "XPD" "kilogram" = (,) Nat Nat 31103477 1000000000
type Scale "XPD" "micrograin" Source # 
type Scale "XPD" "micrograin" = (,) Nat Nat 480000000 1
type Scale "XPD" "microgram" Source # 
type Scale "XPD" "microgram" = (,) Nat Nat 31103477 1
type Scale "XPD" "milligrain" Source # 
type Scale "XPD" "milligrain" = (,) Nat Nat 480000 1
type Scale "XPD" "milligram" Source # 
type Scale "XPD" "milligram" = (,) Nat Nat 31103477 1000
type Scale "XPD" "troy-ounce" Source # 
type Scale "XPD" "troy-ounce" = (,) Nat Nat 1 1
type Scale "XPF" "XPF" Source # 
type Scale "XPF" "XPF" = (,) Nat Nat 100 1
type Scale "XPF" "centime" Source # 
type Scale "XPF" "centime" = (,) Nat Nat 100 1
type Scale "XPF" "franc" Source # 
type Scale "XPF" "franc" = (,) Nat Nat 1 1
type Scale "XPT" "XPT" Source # 
type Scale "XPT" "XPT" = ErrScaleNonCanonical (Nat, Nat) "XPT"
type Scale "XPT" "grain" Source # 
type Scale "XPT" "grain" = (,) Nat Nat 480 1
type Scale "XPT" "gram" Source # 
type Scale "XPT" "gram" = (,) Nat Nat 31103477 1000000
type Scale "XPT" "kilogram" Source # 
type Scale "XPT" "kilogram" = (,) Nat Nat 31103477 1000000000
type Scale "XPT" "micrograin" Source # 
type Scale "XPT" "micrograin" = (,) Nat Nat 480000000 1
type Scale "XPT" "microgram" Source # 
type Scale "XPT" "microgram" = (,) Nat Nat 31103477 1
type Scale "XPT" "milligrain" Source # 
type Scale "XPT" "milligrain" = (,) Nat Nat 480000 1
type Scale "XPT" "milligram" Source # 
type Scale "XPT" "milligram" = (,) Nat Nat 31103477 1000
type Scale "XPT" "troy-ounce" Source # 
type Scale "XPT" "troy-ounce" = (,) Nat Nat 1 1
type Scale "XSU" "XSU" Source # 
type Scale "XSU" "XSU" = (,) Nat Nat 100 1
type Scale "XUA" "XUA" Source # 
type Scale "XUA" "XUA" = (,) Nat Nat 100 1
type Scale "YER" "YER" Source # 
type Scale "YER" "YER" = (,) Nat Nat 100 1
type Scale "YER" "fils" Source # 
type Scale "YER" "fils" = (,) Nat Nat 100 1
type Scale "YER" "rial" Source # 
type Scale "YER" "rial" = (,) Nat Nat 1 1
type Scale "ZAR" "ZAR" Source # 
type Scale "ZAR" "ZAR" = (,) Nat Nat 100 1
type Scale "ZAR" "cent" Source # 
type Scale "ZAR" "cent" = (,) Nat Nat 100 1
type Scale "ZAR" "rand" Source # 
type Scale "ZAR" "rand" = (,) Nat Nat 1 1
type Scale "ZMW" "ZMW" Source # 
type Scale "ZMW" "ZMW" = (,) Nat Nat 100 1
type Scale "ZMW" "kwacha" Source # 
type Scale "ZMW" "kwacha" = (,) Nat Nat 1 1
type Scale "ZMW" "ngwee" Source # 
type Scale "ZMW" "ngwee" = (,) Nat Nat 100 1
type Scale "ZWL" "ZWL" Source # 
type Scale "ZWL" "ZWL" = (,) Nat Nat 100 1
type Scale "ZWL" "cent" Source # 
type Scale "ZWL" "cent" = (,) Nat Nat 100 1
type Scale "ZWL" "dollar" Source # 
type Scale "ZWL" "dollar" = (,) Nat Nat 1 1

type GoodScale scale = (CmpNat 0 (Fst scale) ~ LT, CmpNat 0 (Snd scale) ~ LT, KnownNat (Fst scale), KnownNat (Snd scale)) Source #

Constraints to a scale (like the one returned by Scale currency unit) expected to always be satisfied. In particular, the scale is always guaranteed to be a positive rational number (infinity and notANumber are forbidden by GoodScale).

scale Source #

Arguments

:: GoodScale scale 
=> proxy scale 
-> Rational 

Term-level representation for the currency's unit Scale.

For example, the Scale for "USD" in "cent"s is 100/1.

The returned Rational is statically guaranteed to be a positive number, and to be different from both notANumber and infinity.

Currency exchange

data ExchangeRate src dst Source #

Exchange rate for converting monetary values of currency src into monetary values of currency dst by multiplying for it.

For example, if in order to convert USD to GBP we have to multiply by 1.2345, then we can represent this situaion using:

exchangeRate (12345 % 10000) :: Maybe (ExchangeRate "USD" "GBP")

Instances

Eq (ExchangeRate src dst) Source # 

Methods

(==) :: ExchangeRate src dst -> ExchangeRate src dst -> Bool #

(/=) :: ExchangeRate src dst -> ExchangeRate src dst -> Bool #

Ord (ExchangeRate src dst) Source # 

Methods

compare :: ExchangeRate src dst -> ExchangeRate src dst -> Ordering #

(<) :: ExchangeRate src dst -> ExchangeRate src dst -> Bool #

(<=) :: ExchangeRate src dst -> ExchangeRate src dst -> Bool #

(>) :: ExchangeRate src dst -> ExchangeRate src dst -> Bool #

(>=) :: ExchangeRate src dst -> ExchangeRate src dst -> Bool #

max :: ExchangeRate src dst -> ExchangeRate src dst -> ExchangeRate src dst #

min :: ExchangeRate src dst -> ExchangeRate src dst -> ExchangeRate src dst #

(KnownSymbol src, KnownSymbol dst) => Read (ExchangeRate src dst) Source # 
(KnownSymbol src, KnownSymbol dst) => Show (ExchangeRate src dst) Source # 

Methods

showsPrec :: Int -> ExchangeRate src dst -> ShowS #

show :: ExchangeRate src dst -> String #

showList :: [ExchangeRate src dst] -> ShowS #

Generic (ExchangeRate src dst) Source # 

Associated Types

type Rep (ExchangeRate src dst) :: * -> * #

Methods

from :: ExchangeRate src dst -> Rep (ExchangeRate src dst) x #

to :: Rep (ExchangeRate src dst) x -> ExchangeRate src dst #

Hashable (ExchangeRate src dst) Source # 

Methods

hashWithSalt :: Int -> ExchangeRate src dst -> Int #

hash :: ExchangeRate src dst -> Int #

(KnownSymbol src, KnownSymbol dst) => ToJSON (ExchangeRate src dst) Source #

Compatible with ExchangeRateRep

Methods

toJSON :: ExchangeRate src dst -> Value #

toEncoding :: ExchangeRate src dst -> Encoding #

toJSONList :: [ExchangeRate src dst] -> Value #

toEncodingList :: [ExchangeRate src dst] -> Encoding #

(KnownSymbol src, KnownSymbol dst) => FromJSON (ExchangeRate src dst) Source #

Compatible with ExchangeRateRep

Methods

parseJSON :: Value -> Parser (ExchangeRate src dst) #

parseJSONList :: Value -> Parser [ExchangeRate src dst] #

(KnownSymbol src, KnownSymbol dst) => Binary (ExchangeRate src dst) Source #

Compatible with ExchangeRateRep.

Methods

put :: ExchangeRate src dst -> Put #

get :: Get (ExchangeRate src dst) #

putList :: [ExchangeRate src dst] -> Put #

(KnownSymbol src, KnownSymbol dst) => Serialize (ExchangeRate src dst) Source #

Compatible with ExchangeRateRep.

Methods

put :: Putter (ExchangeRate src dst) #

get :: Get (ExchangeRate src dst) #

NFData (ExchangeRate src dst) Source # 

Methods

rnf :: ExchangeRate src dst -> () #

(KnownSymbol src, KnownSymbol dst) => Store (ExchangeRate src dst) Source #

Compatible with ExchangeRateRep.

Methods

size :: Size (ExchangeRate src dst) #

poke :: ExchangeRate src dst -> Poke () #

peek :: Peek (ExchangeRate src dst) #

type Rep (ExchangeRate src dst) Source # 
type Rep (ExchangeRate src dst) = D1 (MetaData "ExchangeRate" "Data.Money.Internal" "safe-money-0.2-9KEKOJrropPa8pssJxMaR" True) (C1 (MetaCons "ExchangeRate" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Rational)))

exchangeRate :: Rational -> Maybe (ExchangeRate src dst) Source #

Safely construct an ExchangeRate from a Rational number.

For construction to succeed, this Rational must be greater than 0, different from infinity and different from notANumber.

fromExchangeRate :: ExchangeRate src dst -> Rational Source #

Obtain a Rational representation of the ExchangeRate.

This Rational is statically guaranteed to be greater than 0, different from infinity and different from notANumber.

flipExchangeRate :: ExchangeRate a b -> ExchangeRate b a Source #

Flip the direction of an ExchangeRate.

Identity law:

flipExchangeRate . flipExchangeRate   ==  id

exchange :: ExchangeRate src dst -> Dense src -> Dense dst Source #

Apply the ExchangeRate to the given Dense src monetary value.

Identity law:

exchange (flipExchangeRate x) . exchange x  ==  id

Use the Identity law for reasoning about going back and forth between src and dst in order to manage any leftovers that might not be representable as a Discrete monetary value of src.

Serializable representations

data DenseRep Source #

A monomorphic representation of Dense that is easier to serialize and deserialize than Dense in case you don't know the type indexes involved.

Instances

Eq DenseRep Source # 
Ord DenseRep Source # 
Show DenseRep Source # 
Generic DenseRep Source # 

Associated Types

type Rep DenseRep :: * -> * #

Methods

from :: DenseRep -> Rep DenseRep x #

to :: Rep DenseRep x -> DenseRep #

Hashable DenseRep Source # 

Methods

hashWithSalt :: Int -> DenseRep -> Int #

hash :: DenseRep -> Int #

ToJSON DenseRep Source #

Compatible with Dense

FromJSON DenseRep Source #

Compatible with Dense

Binary DenseRep Source #

Compatible with Dense.

Methods

put :: DenseRep -> Put #

get :: Get DenseRep #

putList :: [DenseRep] -> Put #

Serialize DenseRep Source #

Compatible with Dense.

NFData DenseRep Source # 

Methods

rnf :: DenseRep -> () #

Store DenseRep Source #

Compatible with Dense.

type Rep DenseRep Source # 
type Rep DenseRep = D1 (MetaData "DenseRep" "Data.Money.Internal" "safe-money-0.2-9KEKOJrropPa8pssJxMaR" False) (C1 (MetaCons "DenseRep" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "_denseRepCurrency") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 String)) ((:*:) (S1 (MetaSel (Just Symbol "_denseRepAmountNumerator") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer)) (S1 (MetaSel (Just Symbol "_denseRepAmountDenominator") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer)))))

denseRep :: KnownSymbol currency => Dense currency -> DenseRep Source #

Convert a Dense to a DenseRep for ease of serialization.

fromDenseRep Source #

Arguments

:: KnownSymbol currency 
=> DenseRep 
-> Maybe (Dense currency) 

Attempt to convert a DenseRep to a Dense, provided you know the target currency.

withDenseRep Source #

Arguments

:: DenseRep 
-> (forall currency. KnownSymbol currency => Dense currency -> r) 
-> r 

Convert a DenseRep to a Dense without knowing the target currency.

Notice that currency here can't leave its intended scope unless you can prove equality with some other type at the outer scope, but in that case you would be better off using fromDenseRep directly.

data DiscreteRep Source #

A monomorphic representation of Discrete that is easier to serialize and deserialize than Discrete in case you don't know the type indexes involved.

Instances

Eq DiscreteRep Source # 
Ord DiscreteRep Source # 
Show DiscreteRep Source # 
Generic DiscreteRep Source # 

Associated Types

type Rep DiscreteRep :: * -> * #

Hashable DiscreteRep Source # 
ToJSON DiscreteRep Source #

Compatible with Discrete'

FromJSON DiscreteRep Source #

Compatible with Discrete'

Binary DiscreteRep Source #

Compatible with Discrete.

Serialize DiscreteRep Source #

Compatible with Discrete.

NFData DiscreteRep Source # 

Methods

rnf :: DiscreteRep -> () #

Store DiscreteRep Source #

Compatible with Discrete'.

type Rep DiscreteRep Source # 
type Rep DiscreteRep = D1 (MetaData "DiscreteRep" "Data.Money.Internal" "safe-money-0.2-9KEKOJrropPa8pssJxMaR" False) (C1 (MetaCons "DiscreteRep" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "_discreteRepCurrency") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 String)) (S1 (MetaSel (Just Symbol "_discreteRepScaleNumerator") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer))) ((:*:) (S1 (MetaSel (Just Symbol "_discreteRepScaleDenominator") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer)) (S1 (MetaSel (Just Symbol "_discreteRepAmount") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer)))))

discreteRep Source #

Arguments

:: (KnownSymbol currency, GoodScale scale) 
=> Discrete' currency scale 
-> DiscreteRep 

Convert a Discrete to a DiscreteRep for ease of serialization.

fromDiscreteRep Source #

Arguments

:: (KnownSymbol currency, GoodScale scale) 
=> DiscreteRep 
-> Maybe (Discrete' currency scale) 

Attempt to convert a DiscreteRep to a Discrete, provided you know the target currency and unit.

withDiscreteRep Source #

Arguments

:: DiscreteRep 
-> (forall currency scale. (KnownSymbol currency, GoodScale scale) => Discrete' currency scale -> r) 
-> r 

Convert a DiscreteRep to a Discrete without knowing the target currency and unit.

Notice that currency and unit here can't leave its intended scope unless you can prove equality with some other type at the outer scope, but in that case you would be better off using fromDiscreteRep directly.

Notice that you may need to add an explicit type to the result of this function in order to keep the compiler happy.

data ExchangeRateRep Source #

A monomorphic representation of ExchangeRate that is easier to serialize and deserialize than ExchangeRate in case you don't know the type indexes involved.

Instances

Eq ExchangeRateRep Source # 
Ord ExchangeRateRep Source # 
Show ExchangeRateRep Source # 
Generic ExchangeRateRep Source # 
Hashable ExchangeRateRep Source # 
ToJSON ExchangeRateRep Source #

Compatible with ExchangeRate

FromJSON ExchangeRateRep Source #

Compatible with ExchangeRate

Binary ExchangeRateRep Source #

Compatible with ExchangeRate.

Serialize ExchangeRateRep Source #

Compatible with ExchangeRate.

NFData ExchangeRateRep Source # 

Methods

rnf :: ExchangeRateRep -> () #

Store ExchangeRateRep Source #

Compatible with ExchangeRate.

type Rep ExchangeRateRep Source # 
type Rep ExchangeRateRep = D1 (MetaData "ExchangeRateRep" "Data.Money.Internal" "safe-money-0.2-9KEKOJrropPa8pssJxMaR" False) (C1 (MetaCons "ExchangeRateRep" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "_exchangeRateRepSrcCurrency") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 String)) (S1 (MetaSel (Just Symbol "_exchangeRateRepDstCurrency") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 String))) ((:*:) (S1 (MetaSel (Just Symbol "_exchangeRateRepRateNumerator") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer)) (S1 (MetaSel (Just Symbol "_exchangeRateRepRateDenominator") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Integer)))))

exchangeRateRep Source #

Arguments

:: (KnownSymbol src, KnownSymbol dst) 
=> ExchangeRate src dst 
-> ExchangeRateRep 

Convert a ExchangeRate to a DiscreteRep for ease of serialization.

fromExchangeRateRep Source #

Arguments

:: (KnownSymbol src, KnownSymbol dst) 
=> ExchangeRateRep 
-> Maybe (ExchangeRate src dst) 

Attempt to convert a ExchangeRateRep to a ExchangeRate, provided you know the target src and dst types.

withExchangeRateRep Source #

Arguments

:: ExchangeRateRep 
-> (forall src dst. (KnownSymbol src, KnownSymbol dst) => ExchangeRate src dst -> r) 
-> r 

Convert a ExchangeRateRep to a ExchangeRate without knowing the target currency and unit.

Notice that src and dst here can't leave its intended scope unless you can prove equality with some other type at the outer scope, but in that case you would be better off using fromExchangeRateRep directly.