Safe Haskell | None |
---|---|
Language | Haskell2010 |
Experimental support for conversions between units with the same dimension, for example feet and metres. This interface is not necessarily stable!
Rather than defining dimensions explicitly, we pick a "canonical" base unit for each dimension, and record the conversion ratio between each base unit and the canonical base unit for its dimension. This means we can automatically calculate the conversion ratio between a unit and its canonical representation, and hence between any two units that share a dimension (i.e. have the same canonical representation).
For example, to declare m
as a canonical base unit, write:
instance HasCanonicalBaseUnit "m"
To declare ft
as a derived unit, write:
instance HasCanonicalBaseUnit "ft" where type CanonicalBaseUnit "ft" = "m" conversionBase _ = [u| 3.28 ft/m |]
The above declarations can be written using the u
declaration
quasiquoter as [
, or generated
automatically using u
| m, ft = 1 % 3.28 ft/m |]declareConvertibleUnit
.
Now it is possible to convert
between quantities whose units
involve feet or metres. For example:
>>>
convert [u| 10m |] :: Quantity Double [u| ft |]
[u| 32.8 ft |]>>>
convert [u| 3ft^2 |] :: Quantity Double [u| m^2 |]
[u| 0.27885187388459254 m^2 |]
You are likely to get unpleasant compiler error messages if you attempt to convert without the units being fully determined by type inference, or if the units do not have the same dimension.
If you wish to define a dimensionless unit that requires explicit
conversion to 1
, such as radians, write [
.
The syntax u
| rad = 1 1 |][
defines u
| dimensionless = 1 |]dimensionless
as
a unit synonym for 1
that does not require conversion.
- convert :: forall a u v. (Fractional a, Convertible u v) => Quantity a u -> Quantity a v
- ratio :: forall a u v (proxy :: Unit -> *) proxy'. (Fractional a, Convertible u v) => proxy' (proxy u) -> proxy' (proxy v) -> Quantity a (u /: v)
- class IsCanonical (Unpack (CanonicalBaseUnit b)) => HasCanonicalBaseUnit (b :: Symbol) where
- type CanonicalBaseUnit b :: Unit
- type Good u = (u ~ Pack (Unpack u), KnownUnit (Unpack u), HasCanonical (Unpack u))
- type family IsCanonical (u :: UnitSyntax Symbol) :: Constraint where ...
- type family HasCanonical (u :: UnitSyntax Symbol) :: Constraint where ...
- type Convertible u v = (Good u, Good v, ToCanonicalUnit u ~ ToCanonicalUnit v)
- type ToCanonicalUnit u = ToCBU (Unpack u)
Documentation
convert :: forall a u v. (Fractional a, Convertible u v) => Quantity a u -> Quantity a v Source #
Automatically convert a quantity with units u
so that its units
are v
, provided u
and v
have the same dimension.
ratio :: forall a u v (proxy :: Unit -> *) proxy'. (Fractional a, Convertible u v) => proxy' (proxy u) -> proxy' (proxy v) -> Quantity a (u /: v) Source #
Calculate the conversion ratio between two units with the same
dimension. The slightly unusual proxy arguments allow this to be
called using quasiquoters to specify the units, for example
.ratio
[u| ft |] [u| m |]
class IsCanonical (Unpack (CanonicalBaseUnit b)) => HasCanonicalBaseUnit (b :: Symbol) where Source #
Class to capture the dimensions to which base units belong. For a canonical base unit, the class instance can be left empty.
type CanonicalBaseUnit b :: Unit Source #
The canonical base unit for this base unit. If b
is
canonical, then
. Otherwise,
CanonicalBaseUnit
b = b
must itself be canonical.CanonicalBaseUnit
b
conversionBase :: proxy b -> Quantity Rational (Base b /: CanonicalBaseUnit b) Source #
The conversion ratio between this base unit and its canonical
base unit. If b
is canonical then this ratio is 1
.
conversionBase :: Base b ~ CanonicalBaseUnit b => proxy b -> Quantity Rational (Base b /: CanonicalBaseUnit b) Source #
The conversion ratio between this base unit and its canonical
base unit. If b
is canonical then this ratio is 1
.
Constraints
type Good u = (u ~ Pack (Unpack u), KnownUnit (Unpack u), HasCanonical (Unpack u)) Source #
A unit is "good" if all its base units have been defined, and have associated canonical base units.
type family IsCanonical (u :: UnitSyntax Symbol) :: Constraint where ... Source #
This constraint will be satisfied if all the base units in a syntactically represented unit are in their canonical form.
IsCanonical (xs :/ ys) = (AllIsCanonical xs, AllIsCanonical ys) |
type family HasCanonical (u :: UnitSyntax Symbol) :: Constraint where ... Source #
This constraint will be satisfied if all the base units in a syntactically represented unit have associated canonical representations.
HasCanonical (xs :/ ys) = (AllHasCanonical xs, AllHasCanonical ys) |
type Convertible u v = (Good u, Good v, ToCanonicalUnit u ~ ToCanonicalUnit v) Source #
Two units are convertible if they are both Good
and they have
the same canonical units (and hence the same dimension).
type ToCanonicalUnit u = ToCBU (Unpack u) Source #
Converts a unit to the corresponding canonical representation.