{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NumDecimals #-}

{- |
   Copyright  : Copyright (C) 2006-2018 Bjorn Buckwalter
   License    : BSD3

   Maintainer : bjorn@buckwalter.se
   Stability  : Stable
   Portability: GHC only

= Summary

This module defines units that are not part of the SI, with the
exception of those defined in the "Numeric.Units.Dimensional.SIUnits" module (units outside
of the SI accepted for use with the SI).

Any chapters, sections or tables referenced are from <#note1 [1]> unless
otherwise specified.

== Neper, bel, shannon and the like

The units of section 5.1.2 are purposefully (but not permanently)
omitted. In fact the logarithmic units (see section 8.7) are
problematic and it is not clear how to implement them. Perhaps with
a conversion function similar to for degrees Celsius.

= References

1. #note1# https://www.nist.gov/pml/special-publication-811
2. #note2# https://www.iau.org/publications/proceedings_rules/units/
3. #note3# https://en.wikipedia.org/wiki/Pressure
4. #note4# https://en.wikipedia.org/wiki/Torr

-}

module Numeric.Units.Dimensional.NonSI
(
  -- * Units Defined By Experiment
  -- $values-obtained-experimentally
  electronVolt, calorie, unifiedAtomicMassUnit, dalton,
  -- * Dimensionless Units
  percent,
  -- * Standard Gravity
  gee,
  -- * Inch-pound Units
  -- $inch-pound-units
  poundMass, ounce, poundForce, horsepower, btu, shortTon,
  nauticalMile, knot,
  revolution, solid,
  slug, psi,
  teaspoon,
  -- ** International Foot
  foot, inch, mil, yard, mile, acre,
  -- ** US Survey Foot
  usSurveyFoot, usSurveyInch, usSurveyMil, usSurveyYard, usSurveyMile, usSurveyAcre,
  -- * Years
  -- $year
  year, decade, century, millennium,
  -- * Pressure Units
  -- $pressure-units
  bar, atmosphere, technicalAtmosphere, mmHg, inHg, inHg_UCUM, inHg_NIST, torr,
  -- * Radiation Units
  rad,
  -- * Kinematic Viscosity
  stokes,
  -- * Temperature
  -- $temperature
  degreeFahrenheit, degreeRankine,
  -- * Imperial Volumes
  -- $imperial-volumes
  imperialGallon, imperialQuart, imperialPint, imperialCup, imperialGill, imperialFluidOunce,
  -- * US Customary Volumes
  -- $us-customary-volumes
  usGallon, usQuart, usPint, usCup, usGill, usFluidOunce,
  -- * Atomic-Scale Units
  angstrom,
  -- * Units from the Centimeter-Gram-Second Electrostatic System of Units
  gauss
)
where

import Numeric.Units.Dimensional.Prelude
import Numeric.Units.Dimensional.UnitNames.Internal (ucumMetric, ucum, dimensionalAtom)
import qualified Prelude

-- $setup
-- >>> import Data.ExactPi
-- >>> import Data.Function (on)
-- >>> import Numeric.Units.Dimensional.Coercion
-- >>> default (Double)
-- >>> :{
-- >>>   let infix 4 ===
-- >>>       (===) = areExactlyEqual `on` unQuantity :: Quantity d ExactPi -> Quantity d ExactPi -> Bool
-- >>> :}

{- $values-obtained-experimentally

From Table 7, units accepted for use with the SI whose values in SI units are
obtained experimentally.

When <#note1 [1]> was published, the electron volt had a standard combined
uncertainity of 0.00000049e-19 J and the unified atomic mass unit
had a combined uncertainty of 0.0000010e-27 kg.

-}

electronVolt :: Floating a => Unit 'Metric DEnergy a
electronVolt :: Unit 'Metric DEnergy a
electronVolt = UnitName 'Metric
-> ExactPi -> Unit 'Metric DEnergy a -> Unit 'Metric DEnergy a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Floating a =>
UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a
mkUnitR (String -> String -> String -> UnitName 'Metric
ucumMetric String
"eV" String
"eV" String
"electron volt") ExactPi
1.60217733e-19 (Unit 'Metric DEnergy a -> Unit 'Metric DEnergy a)
-> Unit 'Metric DEnergy a -> Unit 'Metric DEnergy a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DEnergy a
forall a. Num a => Unit 'Metric DEnergy a
joule

calorie :: Floating a => Unit 'Metric DEnergy a
calorie :: Unit 'Metric DEnergy a
calorie = UnitName 'Metric
-> ExactPi -> Unit 'Metric DEnergy a -> Unit 'Metric DEnergy a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Floating a =>
UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a
mkUnitR (String -> String -> String -> UnitName 'Metric
ucumMetric String
"cal" String
"cal" String
"calorie") ExactPi
4.184 (Unit 'Metric DEnergy a -> Unit 'Metric DEnergy a)
-> Unit 'Metric DEnergy a -> Unit 'Metric DEnergy a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DEnergy a
forall a. Num a => Unit 'Metric DEnergy a
joule

unifiedAtomicMassUnit :: Floating a => Unit 'Metric DMass a
unifiedAtomicMassUnit :: Unit 'Metric DMass a
unifiedAtomicMassUnit = UnitName 'Metric
-> ExactPi -> Unit 'NonMetric DMass a -> Unit 'Metric DMass a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Floating a =>
UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a
mkUnitR (String -> String -> String -> UnitName 'Metric
ucumMetric String
"u" String
"u" String
"atomic mass unit") ExactPi
1.6605402e-27 (Unit 'NonMetric DMass a -> Unit 'Metric DMass a)
-> Unit 'NonMetric DMass a -> Unit 'Metric DMass a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DMass a -> Unit 'NonMetric DMass a
forall a (d :: Dimension).
Num a =>
Unit 'Metric d a -> Unit 'NonMetric d a
kilo Unit 'Metric DMass a
forall a. Fractional a => Unit 'Metric DMass a
gram

dalton :: Floating a => Unit 'Metric DMass a
dalton :: Unit 'Metric DMass a
dalton = UnitName 'Metric
-> ExactPi -> Unit 'Metric DMass a -> Unit 'Metric DMass a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Floating a =>
UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a
mkUnitR (String -> String -> String -> UnitName 'Metric
ucumMetric String
"u" String
"Da" String
"Dalton") ExactPi
1 (Unit 'Metric DMass a -> Unit 'Metric DMass a)
-> Unit 'Metric DMass a -> Unit 'Metric DMass a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DMass a
forall a. Floating a => Unit 'Metric DMass a
unifiedAtomicMassUnit

-- | One percent is one hundrendth.
--
-- The dimensionless number 0.01, represented by the symbol %, is commonly used as a dimensionless unit.
--
-- See section 7.10.2 of the <#note1 [1]> for further information.
--
-- >>> 1 *~ percent
-- 1.0e-2
percent :: (Fractional a) => Unit 'NonMetric DOne a
percent :: Unit 'NonMetric DOne a
percent = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DOne a -> Unit 'NonMetric DOne a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"%" String
"%" String
"percent") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
100) Unit 'NonMetric DOne a
forall a. Num a => Unit 'NonMetric DOne a
one

-- | One gee is the standard value of the acceleration due to gravity at the
-- Earth's surface, as standardized by CIPM.
--
-- Note that local values of acceleration due to gravity will differ from the
-- standard gravity.
--
-- See <https://en.wikipedia.org/wiki/Standard_gravity here> for further information.
--
-- >>> 1 *~ gee
-- 9.80665 m s^-2
--
-- >>> 1 *~ gee :: Acceleration Rational
-- 196133 % 20000 m s^-2
gee :: Fractional a => Unit 'Metric DAcceleration a
gee :: Unit 'Metric DAcceleration a
gee = UnitName 'Metric
-> Rational
-> Unit 'NonMetric DAcceleration a
-> Unit 'Metric DAcceleration a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'Metric
ucumMetric String
"[g]" String
"g" String
"gee") Rational
9.80665 (Unit 'NonMetric DAcceleration a -> Unit 'Metric DAcceleration a)
-> Unit 'NonMetric DAcceleration a -> Unit 'Metric DAcceleration a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DLength a
forall a. Num a => Unit 'Metric DLength a
meter Unit 'Metric DLength a
-> Dimensional
     ('DUnit 'NonMetric)
     ('Dim 'Zero 'Zero 'Pos2 'Zero 'Zero 'Zero 'Zero)
     a
-> Dimensional
     ('DUnit 'Metric / 'DUnit 'NonMetric)
     (DLength / 'Dim 'Zero 'Zero 'Pos2 'Zero 'Zero 'Zero 'Zero)
     a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 / v2),
 Fractional a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 / v2) (d1 / d2) a
/ Unit 'Metric DTime a
forall a. Num a => Unit 'Metric DTime a
second Unit 'Metric DTime a
-> Proxy 'Pos2
-> Dimensional (Weaken ('DUnit 'Metric)) (DTime ^ 'Pos2) a
forall a (i :: TypeInt) (v :: Variant) (d1 :: Dimension).
(Fractional a, KnownTypeInt i, KnownVariant v,
 KnownVariant (Weaken v)) =>
Dimensional v d1 a -> Proxy i -> Dimensional (Weaken v) (d1 ^ i) a
^ Proxy 'Pos2
pos2

{- $inch-pound-units
Some US customary (that is, inch-pound) units.
-}

-- | One international foot is one third of an international 'yard'.
--
-- See <https://en.wikipedia.org/wiki/Foot_%28unit%29#International_foot here> for further information.
--
-- >>> 1 *~ foot
-- 0.3048 m
--
-- prop> 3 *~ foot === 1 *~ yard
--
-- >>> 1 *~ foot :: Length Rational
-- 381 % 1250 m
foot :: Fractional a => Unit 'NonMetric DLength a
foot :: Unit 'NonMetric DLength a
foot = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[ft_i]" String
"ft" String
"foot") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
3) (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
yard

-- | One inch is one twelth of a 'foot'.
--
-- This inch is based on the international 'foot'.
--
-- See <https://en.wikipedia.org/wiki/Inch#Modern_standardisation here> for further information.
--
-- >>> 1 *~ inch
-- 2.54e-2 m
--
-- prop> 12 *~ inch === 1 *~ foot
--
-- >>> 1 *~ inch :: Length Rational
-- 127 % 5000 m
inch :: Fractional a => Unit 'NonMetric DLength a
inch :: Unit 'NonMetric DLength a
inch = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[in_i]" String
"in" String
"inch") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
12) (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
foot

-- | One mil is one thousandth of an 'inch'.
--
-- This mil is based on the international 'inch'.
--
-- See <https://en.wikipedia.org/wiki/Thousandth_of_an_inch here> for further information.
--
-- >>> 1 *~ mil
-- 2.54e-5 m
--
-- prop> 1000 *~ mil === 1 *~ inch
--
-- >>> 1 *~ mil :: Length Rational
-- 127 % 5000000 m
mil :: Fractional a => Unit 'NonMetric DLength a
mil :: Unit 'NonMetric DLength a
mil = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[mil_i]" String
"mil" String
"mil") Rational
0.001 (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
inch

-- | One yard, as defined by international agreement in 1959, is precisely
-- 0.9144 'meter'.
--
-- See <https://en.wikipedia.org/wiki/Yard here> for further information.
--
-- >>> 1 *~ yard
-- 0.9144 m
--
-- >>> 1 *~ yard :: Length Rational
-- 1143 % 1250 m
yard :: (Fractional a) => Unit 'NonMetric DLength a
yard :: Unit 'NonMetric DLength a
yard = UnitName 'NonMetric
-> Rational -> Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[yd_i]" String
"yd" String
"yard") Rational
0.9144 (Unit 'Metric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DLength a
forall a. Num a => Unit 'Metric DLength a
meter

-- | One mile is 5 280 feet.
--
-- This mile is based on the international 'foot'.
--
-- See <https://en.wikipedia.org/wiki/Mile#International_mile here> for further information.
--
-- >>> 1 *~ mile
-- 1609.344 m
--
-- prop> 1 *~ mile === 5280 *~ foot
--
-- >>> 1 *~ mile :: Length Rational
-- 201168 % 125 m
mile :: (Fractional a) => Unit 'NonMetric DLength a
mile :: Unit 'NonMetric DLength a
mile = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[mi_i]" String
"mi" String
"mile") Rational
5280 (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
foot

-- | One acre is 43 560 square feet.
--
-- This acre is based on the international 'foot'. For the acre based on the US Survey Foot,
-- see 'usSurveyAcre'. While both acres are in use, the difference between them is of little consequence
-- for most applications in which either is used.
--
-- See <https://en.wikipedia.org/wiki/Acre#Differences_between_international_and_US_survey_acres here> for further information.
--
-- >>> 1 *~ acre
-- 4046.8564224 m^2
--
-- prop> 1 *~ acre === 43560 *~ foot ^ pos2
--
-- >>> 1 *~ acre :: Area Rational
-- 316160658 % 78125 m^2
acre :: (Fractional a) => Unit 'NonMetric DArea a
acre :: Unit 'NonMetric DArea a
acre = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DArea a -> Unit 'NonMetric DArea a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"[acr_i]" String
"ac" String
"acre") Rational
43560 (Unit 'NonMetric DArea a -> Unit 'NonMetric DArea a)
-> Unit 'NonMetric DArea a -> Unit 'NonMetric DArea a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a -> Unit 'NonMetric DArea a
forall a (m :: Metricality).
(Fractional a, Typeable m) =>
Unit m DLength a -> Unit 'NonMetric DArea a
square Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
foot

-- | One US survey foot is 1200/3937 'meter'.
--
-- For the international foot, see 'foot'. Note that this is not the foot in routine use
-- in the United States.
--
-- See <https://en.wikipedia.org/wiki/Foot_%28unit%29#US_survey_foot here> for further information.
--
-- >>> 1 *~ usSurveyFoot
-- 0.3048006096012192 m
--
-- >>> 1 *~ usSurveyFoot :: Length Rational
-- 1200 % 3937 m
usSurveyFoot :: Fractional a => Unit 'NonMetric DLength a
usSurveyFoot :: Unit 'NonMetric DLength a
usSurveyFoot = UnitName 'NonMetric
-> Rational -> Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[ft_us]" String
"ft" String
"foot") (Rational
1200 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
3937) (Unit 'Metric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DLength a
forall a. Num a => Unit 'Metric DLength a
meter

-- | One inch is one twelth of a foot.
--
-- This inch is based on the 'usSurveyFoot'. For the inch based on the international foot,
-- see 'inch'. Note that this is not the inch in routine use in the United States.
--
-- See <https://en.wikipedia.org/wiki/Inch here> for further information.
--
-- >>> 1 *~ usSurveyInch
-- 2.54000508001016e-2 m
--
-- prop> 12 *~ usSurveyInch === 1 *~ usSurveyFoot
--
-- >>> 1 *~ usSurveyInch :: Length Rational
-- 100 % 3937 m
usSurveyInch :: Fractional a => Unit 'NonMetric DLength a
usSurveyInch :: Unit 'NonMetric DLength a
usSurveyInch = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[in_us]" String
"in" String
"inch") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
12) (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
usSurveyFoot

-- | One mil is one thousandth of an inch.
--
-- This mil is based on the 'usSurveyInch'. For the mil based on the international inch,
-- see 'mil'. Note that this is not the mil in routine use in the United States.
--
-- See <https://en.wikipedia.org/wiki/Thousandth_of_an_inch here> for further information.
--
-- >>> 1 *~ usSurveyMil
-- 2.54000508001016e-5 m
--
-- prop> 1000 *~ usSurveyMil === 1 *~ usSurveyInch
--
-- >>> 1 *~ usSurveyMil :: Length Rational
-- 1 % 39370 m
usSurveyMil :: Fractional a => Unit 'NonMetric DLength a
usSurveyMil :: Unit 'NonMetric DLength a
usSurveyMil = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[mil_us]" String
"mil" String
"mil") Rational
0.001 (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
usSurveyInch

-- | One yard is three feet.
--
-- This yard is based on the 'usSurveyFoot'. For the international yard,
-- see 'yard'. Note that this is not the yard in routine use in the United States.
--
-- See <https://en.wikipedia.org/wiki/Yard here> for further information.
--
-- >>> 1 *~ usSurveyYard
-- 0.9144018288036576 m
--
-- prop> 1 *~ usSurveyYard === 3 *~ usSurveyFoot
--
-- >>> 1 *~ usSurveyYard :: Length Rational
-- 3600 % 3937 m
usSurveyYard :: (Fractional a) => Unit 'NonMetric DLength a
usSurveyYard :: Unit 'NonMetric DLength a
usSurveyYard = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[yd_us]" String
"yd" String
"yard") Rational
3 (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
usSurveyFoot

-- | One US survey mile is 5 280 US survey feet.
--
-- This mile is based on the 'usSurveyFoot'. For the mile based on the international foot,
-- see 'mile'. Note that this is not the mile in routine use in the United States.
--
-- See <https://en.wikipedia.org/wiki/Mile#US_survey_mile here> for further information.
--
-- >>> 1 *~ usSurveyMile
-- 1609.3472186944373 m
--
-- prop> 1 *~ usSurveyMile === 5280 *~ usSurveyFoot
--
-- >>> 1 *~ usSurveyMile :: Length Rational
-- 6336000 % 3937 m
usSurveyMile :: (Fractional a) => Unit 'NonMetric DLength a
usSurveyMile :: Unit 'NonMetric DLength a
usSurveyMile = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[mi_us]" String
"mi" String
"mile") Rational
5280 (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
usSurveyFoot

-- | One acre is 43 560 square feet.
--
-- This acre is based on the 'usSurveyFoot'. For the acre based on the international foot,
-- see 'acre'. While both acres are in use, the difference between them is of little consequence
-- for most applications in which either is used. This is the only acre defined by the UCUM.
--
-- See <https://en.wikipedia.org/wiki/Acre#Differences_between_international_and_US_survey_acres here> for further information.
--
-- >>> 1 *~ usSurveyAcre
-- 4046.872609874252 m^2
--
-- prop> 1 *~ usSurveyAcre === 43560 *~ usSurveyFoot ^ pos2
--
-- >>> 1 *~ usSurveyAcre :: Area Rational
-- 62726400000 % 15499969 m^2
usSurveyAcre :: (Fractional a) => Unit 'NonMetric DArea a
usSurveyAcre :: Unit 'NonMetric DArea a
usSurveyAcre = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DArea a -> Unit 'NonMetric DArea a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[acr_us]" String
"ac" String
"acre") Rational
43560 (Unit 'NonMetric DArea a -> Unit 'NonMetric DArea a)
-> Unit 'NonMetric DArea a -> Unit 'NonMetric DArea a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a -> Unit 'NonMetric DArea a
forall a (m :: Metricality).
(Fractional a, Typeable m) =>
Unit m DLength a -> Unit 'NonMetric DArea a
square Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
usSurveyFoot

-- | One avoirdupois pound is a mass, exactly defined in terms of the kilogram by the international
-- yard and pound agreement of 1959.
--
-- See <https://en.wikipedia.org/wiki/Avoirdupois#Internationalization here> for further information.
--
-- >>> 1 *~ poundMass
-- 0.45359237 kg
--
-- >>> 1 *~ poundMass :: Mass Rational
-- 45359237 % 100000000 kg
poundMass :: Fractional a => Unit 'NonMetric DMass a
poundMass :: Unit 'NonMetric DMass a
poundMass = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[lb_av]" String
"lb" String
"pound") Rational
0.45359237 (Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a)
-> Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DMass a -> Unit 'NonMetric DMass a
forall a (d :: Dimension).
Num a =>
Unit 'Metric d a -> Unit 'NonMetric d a
kilo Unit 'Metric DMass a
forall a. Fractional a => Unit 'Metric DMass a
gram

-- | One avoirdupois ounce is one sixteenth of a 'poundMass'.
--
-- See <https://en.wikipedia.org/wiki/Ounce#International_avoirdupois_ounce here> for further information.
--
-- >>> 1 *~ ounce
-- 2.8349523125e-2 kg
--
-- prop> 16 *~ ounce === 1 *~ poundMass
--
-- >>> 1 *~ ounce :: Mass Rational
-- 45359237 % 1600000000 kg
ounce :: Fractional a => Unit 'NonMetric DMass a
ounce :: Unit 'NonMetric DMass a
ounce = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[oz_av]" String
"oz" String
"ounce") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
16) (Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a)
-> Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DMass a
forall a. Fractional a => Unit 'NonMetric DMass a
poundMass

-- | One short ton is two thousand 'poundMass'.
--
-- See <https://en.wikipedia.org/wiki/Short_ton#United_States here> for further information.
--
-- >>> 1 *~ shortTon
-- 907.18474 kg
--
-- >>> 1 *~ shortTon :: Mass Rational
-- 45359237 % 50000 kg
shortTon :: Fractional a => Unit 'NonMetric DMass a
shortTon :: Unit 'NonMetric DMass a
shortTon = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[ston_av]" String
"ton" String
"short ton") Rational
2000 (Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a)
-> Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DMass a
forall a. Fractional a => Unit 'NonMetric DMass a
poundMass

-- | The pound-force is equal to the gravitational force exerted on a mass
-- of one avoirdupois pound on the surface of Earth.
--
-- This definition is based on standard gravity (the 'gee') and the
-- international avoirdupois 'poundMass'.
--
-- See <https://en.wikipedia.org/wiki/Pound_%28force%29 here> for further information.
--
-- >>> 1 *~ poundForce
-- 4.4482216152605 m kg s^-2
--
-- prop> 1 *~ poundForce === 1 *~ poundMass * (1 *~ gee)
--
-- >>> 1 *~ poundForce :: Force Rational
-- 8896443230521 % 2000000000000 m kg s^-2
poundForce :: Fractional a => Unit 'NonMetric DForce a
poundForce :: Unit 'NonMetric DForce a
poundForce = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DForce a -> Unit 'NonMetric DForce a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[lbf_av]" String
"lbf" String
"pound force") Rational
1 (Unit 'NonMetric DForce a -> Unit 'NonMetric DForce a)
-> Unit 'NonMetric DForce a -> Unit 'NonMetric DForce a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DMass a
forall a. Fractional a => Unit 'NonMetric DMass a
poundMass Unit 'NonMetric DMass a
-> Dimensional ('DUnit 'Metric) DAcceleration a
-> Dimensional
     ('DUnit 'NonMetric * 'DUnit 'Metric) (DMass * DAcceleration) a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 * v2),
 Num a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 * v2) (d1 * d2) a
* Dimensional ('DUnit 'Metric) DAcceleration a
forall a. Fractional a => Unit 'Metric DAcceleration a
gee

-- | One mechanical horsepower is by definition the power necessary
-- to apply a force of 550 'poundForce' through a distance of one 'foot'
-- per 'second'.
--
-- See <https://en.wikipedia.org/wiki/Horsepower#Mechanical_horsepower here> for further information.
--
-- >>> 1 *~ horsepower
-- 745.6998715822702 m^2 kg s^-3
--
-- prop> 1 *~ horsepower === 550 *~ poundForce * (1 *~ foot) / (1 *~ second)
--
-- >>> 1 *~ horsepower :: Power Rational
-- 37284993579113511 % 50000000000000 m^2 kg s^-3
horsepower :: Fractional a => Unit 'NonMetric DPower a
horsepower :: Unit 'NonMetric DPower a
horsepower = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DPower a -> Unit 'NonMetric DPower a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[HP]" String
"hp" String
"horsepower") Rational
550 (Unit 'NonMetric DPower a -> Unit 'NonMetric DPower a)
-> Unit 'NonMetric DPower a -> Unit 'NonMetric DPower a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
foot Unit 'NonMetric DLength a
-> Dimensional ('DUnit 'NonMetric) DForce a
-> Dimensional
     ('DUnit 'NonMetric * 'DUnit 'NonMetric) (DLength * DForce) a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 * v2),
 Num a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 * v2) (d1 * d2) a
* Dimensional ('DUnit 'NonMetric) DForce a
forall a. Fractional a => Unit 'NonMetric DForce a
poundForce Dimensional ('DUnit 'NonMetric) DEnergy a
-> Dimensional ('DUnit 'Metric) DTime a
-> Dimensional
     ('DUnit 'NonMetric / 'DUnit 'Metric) (DEnergy / DTime) a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 / v2),
 Fractional a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 / v2) (d1 / d2) a
/ Dimensional ('DUnit 'Metric) DTime a
forall a. Num a => Unit 'Metric DTime a
second

-- | The slug is a unit of mass associated with Imperial units and United States customary units.
-- It is a mass that accelerates by 1 foot per second per second when a force of one pound is exerted on it.
--
-- This definition is based on standard gravity (the 'gee'), the international 'foot', and the international avoirdupois 'poundMass'.
--
-- See <https://en.wikipedia.org/wiki/Slug_%28mass%29 here> for further information.
--
-- >>> 1 *~ slug
-- 14.593902937206364 kg
--
-- >>> 1 *~ slug :: Mass Rational
-- 8896443230521 % 609600000000 kg
slug :: Fractional a => Unit 'NonMetric DMass a
slug :: Unit 'NonMetric DMass a
slug = UnitName 'NonMetric
-> Rational -> Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"slug" String
"slug" String
"slug") Rational
1 (Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a)
-> Unit 'NonMetric DMass a -> Unit 'NonMetric DMass a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DForce a
forall a. Fractional a => Unit 'NonMetric DForce a
poundForce Unit 'NonMetric DForce a
-> Dimensional
     ('DUnit 'NonMetric)
     ('Dim 'Zero 'Zero 'Pos2 'Zero 'Zero 'Zero 'Zero)
     a
-> Dimensional
     ('DUnit 'NonMetric * 'DUnit 'NonMetric)
     (DForce * 'Dim 'Zero 'Zero 'Pos2 'Zero 'Zero 'Zero 'Zero)
     a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 * v2),
 Num a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 * v2) (d1 * d2) a
* (Unit 'Metric DTime a
forall a. Num a => Unit 'Metric DTime a
secondUnit 'Metric DTime a
-> Proxy 'Pos2
-> Dimensional (Weaken ('DUnit 'Metric)) (DTime ^ 'Pos2) a
forall a (i :: TypeInt) (v :: Variant) (d1 :: Dimension).
(Fractional a, KnownTypeInt i, KnownVariant v,
 KnownVariant (Weaken v)) =>
Dimensional v d1 a -> Proxy i -> Dimensional (Weaken v) (d1 ^ i) a
^Proxy 'Pos2
pos2) Dimensional
  ('DUnit 'NonMetric)
  ('Dim 'Pos1 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero)
  a
-> Dimensional ('DUnit 'NonMetric) DLength a
-> Dimensional
     ('DUnit 'NonMetric / 'DUnit 'NonMetric)
     ('Dim 'Pos1 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero / DLength)
     a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 / v2),
 Fractional a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 / v2) (d1 / d2) a
/ Dimensional ('DUnit 'NonMetric) DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
foot

-- | One psi is a pressure of one 'poundForce' per 'square' 'inch' of area.
--
-- See <https://en.wikipedia.org/wiki/Pounds_per_square_inch here> for further information.
--
-- >>> 1 *~ psi
-- 6894.757293168362 m^-1 kg s^-2
--
-- >>> 1 *~ psi :: Pressure Rational
-- 8896443230521 % 1290320000 m^-1 kg s^-2
psi :: Fractional a => Unit 'NonMetric DPressure a
psi :: Unit 'NonMetric DPressure a
psi = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DPressure a
-> Unit 'NonMetric DPressure a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[psi]" String
"psi" String
"pound per square inch") Rational
1 (Unit 'NonMetric DPressure a -> Unit 'NonMetric DPressure a)
-> Unit 'NonMetric DPressure a -> Unit 'NonMetric DPressure a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DForce a
forall a. Fractional a => Unit 'NonMetric DForce a
poundForce Unit 'NonMetric DForce a
-> Dimensional ('DUnit 'NonMetric) DArea a
-> Dimensional
     ('DUnit 'NonMetric / 'DUnit 'NonMetric) (DForce / DArea) a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 / v2),
 Fractional a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 / v2) (d1 / d2) a
/ Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
inch Unit 'NonMetric DLength a
-> Proxy 'Pos2
-> Dimensional (Weaken ('DUnit 'NonMetric)) (DLength ^ 'Pos2) a
forall a (i :: TypeInt) (v :: Variant) (d1 :: Dimension).
(Fractional a, KnownTypeInt i, KnownVariant v,
 KnownVariant (Weaken v)) =>
Dimensional v d1 a -> Proxy i -> Dimensional (Weaken v) (d1 ^ i) a
^ Proxy 'Pos2
pos2

-- | One nautical mile is a unit of length, set by international agreement as being exactly 1 852 meters.
--
-- Historically, it was defined as the distance spanned by one minute of arc along a meridian of the Earth.
--
-- See <https://en.wikipedia.org/wiki/Nautical_mile here> for further information.
--
-- >>> 1 *~ nauticalMile
-- 1852.0 m
--
-- >>> 1 *~ nauticalMile :: Length Rational
-- 1852 % 1 m
nauticalMile :: (Num a) => Unit 'NonMetric DLength a
nauticalMile :: Unit 'NonMetric DLength a
nauticalMile = UnitName 'NonMetric
-> Integer -> Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Num a =>
UnitName m -> Integer -> Unit m1 d a -> Unit m d a
mkUnitZ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[nmi_i]" String
"NM" String
"nautical mile") Integer
1852 (Unit 'Metric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DLength a
forall a. Num a => Unit 'Metric DLength a
meter

-- | One knot is a velocity equal to one 'nauticalMile' per 'hour'.
--
-- See <https://en.wikipedia.org/wiki/Knot_%28unit%29 here> for further information.
--
-- >>> 1 *~ knot
-- 0.5144444444444445 m s^-1
--
-- >>> 1 *~ knot :: Velocity Rational
-- 463 % 900 m s^-1
knot :: (Fractional a) => Unit 'NonMetric DVelocity a
knot :: Unit 'NonMetric DVelocity a
knot = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVelocity a
-> Unit 'NonMetric DVelocity a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[kt_i]" String
"kt" String
"knot") Rational
1 (Unit 'NonMetric DVelocity a -> Unit 'NonMetric DVelocity a)
-> Unit 'NonMetric DVelocity a -> Unit 'NonMetric DVelocity a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a
forall a. Num a => Unit 'NonMetric DLength a
nauticalMile Unit 'NonMetric DLength a
-> Dimensional ('DUnit 'NonMetric) DTime a
-> Dimensional
     ('DUnit 'NonMetric / 'DUnit 'NonMetric) (DLength / DTime) a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 / v2),
 Fractional a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 / v2) (d1 / d2) a
/ Dimensional ('DUnit 'NonMetric) DTime a
forall a. Num a => Unit 'NonMetric DTime a
hour

-- | One revolution is an angle equal to 2*pi radians; a full circle.
--
-- See <https://en.wikipedia.org/wiki/Turn_%28geometry%29 here> for further information.
--
-- >>> 1 *~ revolution
-- 6.283185307179586
--
-- prop> 1 *~ revolution === _2 * pi * (1 *~ radian)
--
-- prop> 1 *~ revolution === 360 *~ degree
revolution :: (Floating a) => Unit 'NonMetric DOne a
revolution :: Unit 'NonMetric DOne a
revolution = UnitName 'NonMetric
-> ExactPi -> Unit 'Metric DOne a -> Unit 'NonMetric DOne a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Floating a =>
UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a
mkUnitR (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"rev" String
"rev" String
"revolution") (ExactPi
2 ExactPi -> ExactPi -> ExactPi
forall a. Num a => a -> a -> a
Prelude.* ExactPi
forall a. Floating a => a
Prelude.pi) (Unit 'Metric DOne a -> Unit 'NonMetric DOne a)
-> Unit 'Metric DOne a -> Unit 'NonMetric DOne a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DOne a
forall a. Num a => Unit 'Metric DOne a
radian

solid :: (Floating a) => Unit 'NonMetric DOne a
solid :: Unit 'NonMetric DOne a
solid = UnitName 'NonMetric
-> ExactPi -> Unit 'Metric DOne a -> Unit 'NonMetric DOne a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Floating a =>
UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a
mkUnitR (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"solid" String
"solid" String
"solid") (ExactPi
4 ExactPi -> ExactPi -> ExactPi
forall a. Num a => a -> a -> a
Prelude.* ExactPi
forall a. Floating a => a
Prelude.pi) (Unit 'Metric DOne a -> Unit 'NonMetric DOne a)
-> Unit 'Metric DOne a -> Unit 'NonMetric DOne a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DOne a
forall a. Num a => Unit 'Metric DOne a
steradian

teaspoon :: (Fractional a) => Unit 'NonMetric DVolume a
teaspoon :: Unit 'NonMetric DVolume a
teaspoon = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[tsp_m]" String
"tsp" String
"teaspoon") Rational
5 (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DVolume a -> Unit 'NonMetric DVolume a
forall a (d :: Dimension).
Fractional a =>
Unit 'Metric d a -> Unit 'NonMetric d a
milli Unit 'Metric DVolume a
forall a. Fractional a => Unit 'Metric DVolume a
liter

-- | One btu is is the 'QuantityOfHeat' required to raise the temperature
-- of 1 avoirdupois 'poundMass' of liquid water by 1 'degreeFahrenheit' at a constant pressure of one 'atmosphere'.
--
-- Because this value must be determined experimentally and varies with temperature, several standardized
-- values of the btu have arisen. This is the value based on the International Steam Table calorie,
-- defined by the Fifth International Conference on the Properties of Steam.
--
-- See <https://en.wikipedia.org/wiki/British_thermal_unit#Definitions here> for further information.
--
-- >>> 1 *~ btu
-- 1055.05585262 m^2 kg s^-2
--
-- >>> 1 *~ btu :: Energy Rational
-- 52752792631 % 50000000 m^2 kg s^-2
btu :: Fractional a => Unit 'NonMetric DEnergy a
btu :: Unit 'NonMetric DEnergy a
btu = UnitName 'NonMetric
-> Rational -> Unit 'Metric DEnergy a -> Unit 'NonMetric DEnergy a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[Btu_IT]" String
"btu" String
"British thermal unit") Rational
1055.05585262 (Unit 'Metric DEnergy a -> Unit 'NonMetric DEnergy a)
-> Unit 'Metric DEnergy a -> Unit 'NonMetric DEnergy a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DEnergy a
forall a. Num a => Unit 'Metric DEnergy a
joule


{- $year

The IAU recommends <#note2 [2]> that:

  Although there are several different kinds of year (as there are
  several kinds of day), it is best to regard a year as a Julian
  year of 365.25 days (31557600 s) unless otherwise specified.

-}

-- | One Julian year is a unit of measurement of time defined as exactly 365.25 days of 86 400 'second's each.
--
-- See <https://en.wikipedia.org/wiki/Julian_year_%28astronomy%29 here> for further information.
--
-- prop> 1 *~ year === 365.25 *~ day
--
-- >>> 1 *~ year
-- 3.15576e7 s
--
-- >>> 1 *~ year :: Time Rational
-- 31557600 % 1 s
year :: Num a => Unit 'NonMetric DTime a
year :: Unit 'NonMetric DTime a
year = UnitName 'NonMetric
-> Integer -> Unit 'Metric DTime a -> Unit 'NonMetric DTime a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Num a =>
UnitName m -> Integer -> Unit m1 d a -> Unit m d a
mkUnitZ (String -> String -> String -> UnitName 'NonMetric
ucum String
"a_j" String
"a" String
"mean Julian year") Integer
31557600 (Unit 'Metric DTime a -> Unit 'NonMetric DTime a)
-> Unit 'Metric DTime a -> Unit 'NonMetric DTime a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DTime a
forall a. Num a => Unit 'Metric DTime a
second

-- | One Julian decade is ten Julian 'year's.
--
-- prop> 1 *~ decade === 10 *~ year
--
-- >>> 1 *~ decade
-- 3.15576e8 s
--
-- >>> 1 *~ decade :: Time Rational
-- 315576000 % 1 s
decade :: Num a => Unit 'NonMetric DTime a
decade :: Unit 'NonMetric DTime a
decade = UnitName 'NonMetric
-> Integer -> Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Num a =>
UnitName m -> Integer -> Unit m1 d a -> Unit m d a
mkUnitZ (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"d_j" String
"dec" String
"mean Julian decade") Integer
10 (Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a)
-> Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DTime a
forall a. Num a => Unit 'NonMetric DTime a
year

-- | One Julian century is one hundred Julian 'year's, or 35 525 'day's of 86 400 'second's each.
--
-- prop> 1 *~ century === 100 *~ year
--
-- prop> 1 *~ century === 36525 *~ day
--
-- >>> 1 *~ century
-- 3.15576e9 s
--
-- >>> 1 *~ century :: Time Rational
-- 3155760000 % 1 s
century :: Num a => Unit 'NonMetric DTime a
century :: Unit 'NonMetric DTime a
century = UnitName 'NonMetric
-> Integer -> Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Num a =>
UnitName m -> Integer -> Unit m1 d a -> Unit m d a
mkUnitZ (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"c_j" String
"cen" String
"mean Julian century") Integer
100 (Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a)
-> Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DTime a
forall a. Num a => Unit 'NonMetric DTime a
year

-- | One Julian millennium is one thousand Julian 'year's.
--
-- prop> 1 *~ millennium === 1000 *~ year
--
-- >>> 1 *~ millennium
-- 3.15576e10 s
--
-- >>> 1 *~ millennium :: Time Rational
-- 31557600000 % 1 s
millennium :: Num a => Unit 'NonMetric DTime a
millennium :: Unit 'NonMetric DTime a
millennium = UnitName 'NonMetric
-> Integer -> Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Num a =>
UnitName m -> Integer -> Unit m1 d a -> Unit m d a
mkUnitZ (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"m_j" String
"mil" String
"mean Julian millennium") Integer
1000 (Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a)
-> Unit 'NonMetric DTime a -> Unit 'NonMetric DTime a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DTime a
forall a. Num a => Unit 'NonMetric DTime a
year

{- $pressure-units
It seems that nearly every area of application has its own customary unit for measuring pressure.
We include some of the common ones here. 'psi' was defined earlier.
-}

-- | The bar is exactly 100 000 'Numeric.Units.Dimensional.SIUnits.pascal'.
--
-- From Wikipedia:
--
--  It is about equal to the atmospheric pressure on Earth at sea level.
--
-- >>> 1 *~ bar
-- 100000.0 m^-1 kg s^-2
--
-- >>> 1 *~ bar :: Pressure Rational
-- 100000 % 1 m^-1 kg s^-2
bar :: (Num a) => Unit 'Metric DPressure a
bar :: Unit 'Metric DPressure a
bar = UnitName 'Metric
-> Integer -> Unit 'Metric DPressure a -> Unit 'Metric DPressure a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Num a =>
UnitName m -> Integer -> Unit m1 d a -> Unit m d a
mkUnitZ (String -> String -> String -> UnitName 'Metric
ucumMetric String
"bar" String
"bar" String
"bar") Integer
1e5 (Unit 'Metric DPressure a -> Unit 'Metric DPressure a)
-> Unit 'Metric DPressure a -> Unit 'Metric DPressure a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DPressure a
forall a. Num a => Unit 'Metric DPressure a
pascal

-- | The "standard atmosphere".
--
-- From Wikipedia <#note3 [3]>:
--
--  The standard atmosphere (atm) is an established constant. It is
--  approximately equal to typical air pressure at earth mean sea
--  level.
--
-- >>> 1 *~ atmosphere
-- 101325.0 m^-1 kg s^-2
--
-- >>> 1 *~ atmosphere :: Pressure Rational
-- 101325 % 1 m^-1 kg s^-2
atmosphere :: (Num a) => Unit 'NonMetric DPressure a
atmosphere :: Unit 'NonMetric DPressure a
atmosphere = UnitName 'NonMetric
-> Integer
-> Unit 'Metric DPressure a
-> Unit 'NonMetric DPressure a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Num a =>
UnitName m -> Integer -> Unit m1 d a -> Unit m d a
mkUnitZ (String -> String -> String -> UnitName 'NonMetric
ucum String
"atm" String
"atm" String
"standard atmosphere") Integer
101325 (Unit 'Metric DPressure a -> Unit 'NonMetric DPressure a)
-> Unit 'Metric DPressure a -> Unit 'NonMetric DPressure a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DPressure a
forall a. Num a => Unit 'Metric DPressure a
pascal

-- | The "technical atmosphere"
--
-- From Wikipedia:
--
--  A technical atmosphere (symbol: at) is a non-SI unit of pressure equal
--  to one kilogram-force per square centimeter.
--
-- >>> 1 *~ technicalAtmosphere
-- 98066.5 m^-1 kg s^-2
--
-- >>> 1 *~ technicalAtmosphere :: Pressure Rational
-- 196133 % 2 m^-1 kg s^-2
technicalAtmosphere :: (Fractional a) => Unit 'NonMetric DPressure a
technicalAtmosphere :: Unit 'NonMetric DPressure a
technicalAtmosphere = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DPressure a
-> Unit 'NonMetric DPressure a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"att" String
"at" String
"technical atmosphere") Rational
1 (Unit 'NonMetric DPressure a -> Unit 'NonMetric DPressure a)
-> Unit 'NonMetric DPressure a -> Unit 'NonMetric DPressure a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DMass a -> Unit 'NonMetric DMass a
forall a (d :: Dimension).
Num a =>
Unit 'Metric d a -> Unit 'NonMetric d a
kilo Unit 'Metric DMass a
forall a. Fractional a => Unit 'Metric DMass a
gram Unit 'NonMetric DMass a
-> Dimensional ('DUnit 'Metric) DAcceleration a
-> Dimensional
     ('DUnit 'NonMetric * 'DUnit 'Metric) (DMass * DAcceleration) a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 * v2),
 Num a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 * v2) (d1 * d2) a
* Dimensional ('DUnit 'Metric) DAcceleration a
forall a. Fractional a => Unit 'Metric DAcceleration a
gee Dimensional ('DUnit 'NonMetric) DForce a
-> Dimensional
     ('DUnit 'NonMetric)
     ('Dim 'Neg2 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero)
     a
-> Dimensional
     ('DUnit 'NonMetric * 'DUnit 'NonMetric)
     (DForce * 'Dim 'Neg2 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero)
     a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 * v2),
 Num a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 * v2) (d1 * d2) a
* Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a (d :: Dimension).
Fractional a =>
Unit 'Metric d a -> Unit 'NonMetric d a
centi Unit 'Metric DLength a
forall a. Num a => Unit 'Metric DLength a
meter Unit 'NonMetric DLength a
-> Proxy 'Neg2
-> Dimensional (Weaken ('DUnit 'NonMetric)) (DLength ^ 'Neg2) a
forall a (i :: TypeInt) (v :: Variant) (d1 :: Dimension).
(Fractional a, KnownTypeInt i, KnownVariant v,
 KnownVariant (Weaken v)) =>
Dimensional v d1 a -> Proxy i -> Dimensional (Weaken v) (d1 ^ i) a
^ Proxy 'Neg2
neg2

-- | The conventional value for the pressure exerted by a 1 mm high column of mercury.
--
-- Per Wikipedia <#note4 [4]>, one mmHg (millimeter of mercury) is defined as:
--
--  The pressure exerted at the base of a column of fluid exactly 1 mm high,
--  when the density of the fluid is exactly 13.5951 g/cm^3, at a place
--  where the acceleration of gravity is exactly 9.80665 m/s^2.
--
-- The chosen fluid density approximately corresponds to that of mercury
-- at 0 deg. Under most conditions, 1 mmHg is approximately equal to 1 'torr'.
--
-- >>> 1 *~ mmHg
-- 133.322 m^-1 kg s^-2
--
-- >>> 1 *~ mmHg :: Pressure Rational
-- 66661 % 500 m^-1 kg s^-2
mmHg :: (Fractional a) => Unit 'NonMetric DPressure a
mmHg :: Unit 'NonMetric DPressure a
mmHg = Unit 'Metric DPressure a -> Unit 'NonMetric DPressure a
forall a (d :: Dimension).
Fractional a =>
Unit 'Metric d a -> Unit 'NonMetric d a
milli Unit 'Metric DPressure a
forall a. Fractional a => Unit 'Metric DPressure a
mHg

mHg :: (Fractional a) => Unit 'Metric DPressure a
mHg :: Unit 'Metric DPressure a
mHg = UnitName 'Metric
-> Rational
-> Unit 'NonMetric DPressure a
-> Unit 'Metric DPressure a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'Metric
ucumMetric String
"m[Hg]" String
"m Hg" String
"meter of mercury") Rational
133.3220 (Unit 'NonMetric DPressure a -> Unit 'Metric DPressure a)
-> Unit 'NonMetric DPressure a -> Unit 'Metric DPressure a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DPressure a -> Unit 'NonMetric DPressure a
forall a (d :: Dimension).
Num a =>
Unit 'Metric d a -> Unit 'NonMetric d a
kilo Unit 'Metric DPressure a
forall a. Num a => Unit 'Metric DPressure a
pascal

-- | The conventional value for the pressure exerted by a 1 inch high column of mercury.
--
-- Column inches of mercury are also used to measure pressure, especially in
-- meteorological or aeronautical contexts in the United States.
--
-- This is the value defined by UCUM. For the value defined by NIST, see 'inHg_NIST'.
--
-- >>> 1 *~ inHg
-- 3386.3788 m^-1 kg s^-2
--
-- >>> 1 *~ inHg :: Pressure Rational
-- 8465947 % 2500 m^-1 kg s^-2
inHg :: (Fractional a) => Unit 'NonMetric DPressure a
inHg :: Unit 'NonMetric DPressure a
inHg = Unit 'NonMetric DPressure a
forall a. Fractional a => Unit 'NonMetric DPressure a
inHg_UCUM

-- | The conventional value for the pressure exerted by a 1 inch high column of mercury.
--
-- Column inches of mercury are also used to measure pressure, especially in
-- meteorological or aeronautical contexts in the United States.
--
-- This is the value defined by UCUM. For the value defined by NIST, see 'inHg_NIST'.
--
-- >>> 1 *~ inHg_UCUM
-- 3386.3788 m^-1 kg s^-2
--
-- >>> 1 *~ inHg_UCUM :: Pressure Rational
-- 8465947 % 2500 m^-1 kg s^-2
inHg_UCUM :: (Fractional a) => Unit 'NonMetric DPressure a
inHg_UCUM :: Unit 'NonMetric DPressure a
inHg_UCUM = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DPressure a
-> Unit 'NonMetric DPressure a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[in_i'Hg]" String
"in Hg" String
"inch of mercury") Rational
1 (Unit 'NonMetric DPressure a -> Unit 'NonMetric DPressure a)
-> Unit 'NonMetric DPressure a -> Unit 'NonMetric DPressure a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DPressure a
forall a. Fractional a => Unit 'Metric DPressure a
mHg Unit 'Metric DPressure a
-> Dimensional ('DUnit 'NonMetric) DLength a
-> Dimensional
     ('DUnit 'Metric * 'DUnit 'NonMetric) (DPressure * DLength) a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 * v2),
 Num a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 * v2) (d1 * d2) a
* Dimensional ('DUnit 'NonMetric) DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
inch Dimensional
  ('DUnit 'NonMetric)
  ('Dim 'Zero 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero)
  a
-> Dimensional ('DUnit 'Metric) DLength a
-> Dimensional
     ('DUnit 'NonMetric / 'DUnit 'Metric)
     ('Dim 'Zero 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero / DLength)
     a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 / v2),
 Fractional a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 / v2) (d1 / d2) a
/ Dimensional ('DUnit 'Metric) DLength a
forall a. Num a => Unit 'Metric DLength a
meter

-- | The conventional value for the pressure exerted by a 1 inch high column of mercury.
--
-- Column inches of mercury are also used to measure pressure, especially in
-- meteorological or aeronautical contexts in the United States.
--
-- This is the value defined by NIST. For the value defined by UCUM, see 'inHg_UCUM'.
--
-- >>> 1 *~ inHg_NIST
-- 3386.389 m^-1 kg s^-2
--
-- >>> 1 *~ inHg_NIST :: Pressure Rational
-- 3386389 % 1000 m^-1 kg s^-2
inHg_NIST :: (Fractional a) => Unit 'NonMetric DPressure a
inHg_NIST :: Unit 'NonMetric DPressure a
inHg_NIST = UnitName 'NonMetric
-> Rational
-> Unit 'Metric DPressure a
-> Unit 'NonMetric DPressure a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"[in_i'Hg_NIST]" String
"in Hg" String
"inch of mercury") Rational
3.386389e3 (Unit 'Metric DPressure a -> Unit 'NonMetric DPressure a)
-> Unit 'Metric DPressure a -> Unit 'NonMetric DPressure a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DPressure a
forall a. Num a => Unit 'Metric DPressure a
pascal

-- | One torr (symbol: Torr) is defined as 1/760 'atmosphere', which is approximately equal to 1 'mmHg'.
--
-- See <https://en.wikipedia.org/wiki/Torr here> for further information.
--
-- >>> 1 *~ torr
-- 133.32236842105263 m^-1 kg s^-2
--
-- >>> 1 *~ torr :: Pressure Rational
-- 20265 % 152 m^-1 kg s^-2
torr :: (Fractional a) => Unit 'NonMetric DPressure a
torr :: Unit 'NonMetric DPressure a
torr = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DPressure a
-> Unit 'NonMetric DPressure a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"Torr" String
"Torr" String
"Torr") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
760) (Unit 'NonMetric DPressure a -> Unit 'NonMetric DPressure a)
-> Unit 'NonMetric DPressure a -> Unit 'NonMetric DPressure a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DPressure a
forall a. Num a => Unit 'NonMetric DPressure a
atmosphere

-- | The rad is a deprecated unit of 'AbsorbedDose', defined as
-- 0.01 'gray'.
--
-- See <https://en.wikipedia.org/wiki/Rad_%28unit%29 here> for further information.
--
-- >>> 1 *~ rad
-- 1.0e-2 m^2 s^-2
--
-- >>> 1 *~ rad :: AbsorbedDose Rational
-- 1 % 100 m^2 s^-2
rad :: (Fractional a) => Unit 'Metric DAbsorbedDose a
rad :: Unit 'Metric DAbsorbedDose a
rad = UnitName 'Metric
-> Rational
-> Unit 'NonMetric DAbsorbedDose a
-> Unit 'Metric DAbsorbedDose a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'Metric
ucumMetric String
"RAD" String
"RAD" String
"RAD") Rational
1 (Unit 'NonMetric DAbsorbedDose a -> Unit 'Metric DAbsorbedDose a)
-> Unit 'NonMetric DAbsorbedDose a -> Unit 'Metric DAbsorbedDose a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DAbsorbedDose a -> Unit 'NonMetric DAbsorbedDose a
forall a (d :: Dimension).
Fractional a =>
Unit 'Metric d a -> Unit 'NonMetric d a
centi Unit 'Metric DAbsorbedDose a
forall a. Num a => Unit 'Metric DAbsorbedDose a
gray

-- | One Stokes is a unit of 'KinematicViscosity' equal to @1 cm^2 / s@.
--
-- See <https://en.wikipedia.org/wiki/Viscosity#Kinematic_viscosity_.CE.BD here> for further information.
--
-- >>> 1 *~ stokes
-- 1.0e-4 m^2 s^-1
--
-- >>> 1 *~ stokes :: KinematicViscosity Rational
-- 1 % 10000 m^2 s^-1
stokes :: (Fractional a) => Unit 'Metric DKinematicViscosity a
stokes :: Unit 'Metric DKinematicViscosity a
stokes = UnitName 'Metric
-> Rational
-> Unit 'NonMetric DKinematicViscosity a
-> Unit 'Metric DKinematicViscosity a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'Metric
ucumMetric String
"St" String
"St" String
"Stokes") Rational
1 (Unit 'NonMetric DKinematicViscosity a
 -> Unit 'Metric DKinematicViscosity a)
-> Unit 'NonMetric DKinematicViscosity a
-> Unit 'Metric DKinematicViscosity a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a (d :: Dimension).
Fractional a =>
Unit 'Metric d a -> Unit 'NonMetric d a
centi Unit 'Metric DLength a
forall a. Num a => Unit 'Metric DLength a
meter Unit 'NonMetric DLength a
-> Proxy 'Pos2
-> Dimensional (Weaken ('DUnit 'NonMetric)) (DLength ^ 'Pos2) a
forall a (i :: TypeInt) (v :: Variant) (d1 :: Dimension).
(Fractional a, KnownTypeInt i, KnownVariant v,
 KnownVariant (Weaken v)) =>
Dimensional v d1 a -> Proxy i -> Dimensional (Weaken v) (d1 ^ i) a
^ Proxy 'Pos2
pos2 Dimensional ('DUnit 'NonMetric) DArea a
-> Dimensional ('DUnit 'Metric) DTime a
-> Dimensional
     ('DUnit 'NonMetric / 'DUnit 'Metric) (DArea / DTime) a
forall (v1 :: Variant) (v2 :: Variant) a (d1 :: Dimension)
       (d2 :: Dimension).
(KnownVariant v1, KnownVariant v2, KnownVariant (v1 / v2),
 Fractional a) =>
Dimensional v1 d1 a
-> Dimensional v2 d2 a -> Dimensional (v1 / v2) (d1 / d2) a
/ Dimensional ('DUnit 'Metric) DTime a
forall a. Num a => Unit 'Metric DTime a
second

{- $temperature
These units of temperature are relative. For absolute temperatures, see 'Numeric.Units.Dimensional.SIUnits.fromDegreeCelsiusAbsolute'.
-}

-- | One degree Fahrenheit is a unit of relative temperature equal to 5/9 'kelvin'.
--
-- Note that although the Fahrenheit scale is an absolute temperature scale, this unit is a unit of difference within
-- that scale and measures relative temperature.
--
-- See <https://en.wikipedia.org/wiki/Fahrenheit#Definition_and_conversions here> for further information.
--
-- >>> 1 *~ degreeFahrenheit
-- 0.5555555555555556 K
--
-- >>> 1 *~ degreeFahrenheit :: ThermodynamicTemperature Rational
-- 5 % 9 K
degreeFahrenheit :: (Fractional a) => Unit 'NonMetric DThermodynamicTemperature a
degreeFahrenheit :: Unit 'NonMetric DThermodynamicTemperature a
degreeFahrenheit = UnitName 'NonMetric
-> Rational
-> Unit 'Metric DThermodynamicTemperature a
-> Unit 'NonMetric DThermodynamicTemperature a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[degF]" String
"°F" String
"degree Fahrenheit") (Rational
5 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
9) (Unit 'Metric DThermodynamicTemperature a
 -> Unit 'NonMetric DThermodynamicTemperature a)
-> Unit 'Metric DThermodynamicTemperature a
-> Unit 'NonMetric DThermodynamicTemperature a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DThermodynamicTemperature a
forall a. Num a => Unit 'Metric DThermodynamicTemperature a
degreeCelsius

-- | One degree Rankine is a unit of relative temperature equal to 5/9 'kelvin'.
--
-- Note that although the Rankine scale is an absolute temperature scale, this unit is a unit of difference within
-- that scale and measures relative temperature.
--
-- See <https://en.wikipedia.org/wiki/Rankine_scale here> for further information.
--
-- >>> 1 *~ degreeRankine
-- 0.5555555555555556 K
--
-- >>> 1 *~ degreeRankine :: ThermodynamicTemperature Rational
-- 5 % 9 K
degreeRankine :: (Fractional a) => Unit 'NonMetric DThermodynamicTemperature a
degreeRankine :: Unit 'NonMetric DThermodynamicTemperature a
degreeRankine = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DThermodynamicTemperature a
-> Unit 'NonMetric DThermodynamicTemperature a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[degR]" String
"°R" String
"degree Rankine") Rational
1 (Unit 'NonMetric DThermodynamicTemperature a
 -> Unit 'NonMetric DThermodynamicTemperature a)
-> Unit 'NonMetric DThermodynamicTemperature a
-> Unit 'NonMetric DThermodynamicTemperature a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DThermodynamicTemperature a
forall a.
Fractional a =>
Unit 'NonMetric DThermodynamicTemperature a
degreeFahrenheit

{- $imperial-volumes
Per https://en.wikipedia.org/wiki/Imperial_units and https://en.wikipedia.org/wiki/Cup_(unit)#Imperial_cup.
-}

-- | One imperial gallon is defined exactly in terms of the 'liter'
-- by the Weights and Measures Act 1985.
--
-- See <https://en.wikipedia.org/wiki/Imperial_units#Volume here> for further information.
--
-- >>> 1 *~ imperialGallon
-- 4.54609e-3 m^3
--
-- >>> 1 *~ imperialGallon :: Volume Rational
-- 454609 % 100000000 m^3
imperialGallon :: (Fractional a) => Unit 'NonMetric DVolume a
imperialGallon :: Unit 'NonMetric DVolume a
imperialGallon = UnitName 'NonMetric
-> Rational -> Unit 'Metric DVolume a -> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[gal_br]" String
"gal" String
"gallon") Rational
4.54609 (Unit 'Metric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'Metric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DVolume a
forall a. Fractional a => Unit 'Metric DVolume a
liter

-- | One imperial quart is one quarter of an 'imperialGallon'.
--
-- See <https://en.wikipedia.org/wiki/Imperial_units#Volume here> for further information.
--
-- >>> 1 *~ imperialQuart
-- 1.1365225e-3 m^3
--
-- >>> 1 *~ imperialQuart :: Volume Rational
-- 454609 % 400000000 m^3
imperialQuart :: (Fractional a) => Unit 'NonMetric DVolume a
imperialQuart :: Unit 'NonMetric DVolume a
imperialQuart = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[qt_br]" String
"qt" String
"quart") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
4) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
imperialGallon

-- | One imperial pint is one half of an 'imperialQuart'.
--
-- See <https://en.wikipedia.org/wiki/Imperial_units#Volume here> for further information.
--
-- >>> 1 *~ imperialPint
-- 5.6826125e-4 m^3
--
-- >>> 1 *~ imperialPint :: Volume Rational
-- 454609 % 800000000 m^3
imperialPint :: (Fractional a) => Unit 'NonMetric DVolume a
imperialPint :: Unit 'NonMetric DVolume a
imperialPint = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[pt_br]" String
"pt" String
"pint") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
8) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
imperialGallon

-- | One imperial cup is one half of an 'imperialPint'.
--
-- This unit is not in common use and is does not appear in some sources
-- describing the imperial fluid volume units.
--
-- See <https://en.wikipedia.org/wiki/Cup_%28unit%29#Imperial_cup here> for further information.
--
-- >>> 1 *~ imperialCup
-- 2.84130625e-4 m^3
--
-- >>> 1 *~ imperialCup :: Volume Rational
-- 454609 % 1600000000 m^3
imperialCup :: (Fractional a) => Unit 'NonMetric DVolume a
imperialCup :: Unit 'NonMetric DVolume a
imperialCup = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
dimensionalAtom String
"[cup_br]" String
"cup" String
"cup") Rational
0.5 (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
imperialPint

-- | One imperial gill is one quarter of an 'imperialPint'.
--
-- See <https://en.wikipedia.org/wiki/Imperial_units#Volume here> for further information.
--
-- >>> 1 *~ imperialGill
-- 1.420653125e-4 m^3
--
-- >>> 1 *~ imperialGill :: Volume Rational
-- 454609 % 3200000000 m^3
imperialGill :: (Fractional a) => Unit 'NonMetric DVolume a
imperialGill :: Unit 'NonMetric DVolume a
imperialGill = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[gil_br]" String
"gill" String
"gill") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
4) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
imperialPint

-- | One imperial fluid ounce is one twentieth of an 'imperialPint'.
--
-- See <https://en.wikipedia.org/wiki/Imperial_units#Volume here> for further information.
--
-- >>> 1 *~ imperialFluidOunce
-- 2.84130625e-5 m^3
--
-- >>> 1 *~ imperialFluidOunce :: Volume Rational
-- 454609 % 16000000000 m^3
imperialFluidOunce :: (Fractional a) => Unit 'NonMetric DVolume a
imperialFluidOunce :: Unit 'NonMetric DVolume a
imperialFluidOunce = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[foz_br]" String
"fl oz" String
"fluid ounce") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
20) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
imperialPint

{- $us-customary-volumes
Per https://www.nist.gov/system/files/documents/2017/05/09/2012-hb44-final.pdf page 452 and https://en.wikipedia.org/wiki/United_States_customary_units#Fluid_volume
Note that there exist rarely-used "dry" variants of units with overlapping names.
-}

-- | One US liquid gallon is a volume of 231 cubic inches.
--
-- See <https://en.wikipedia.org/wiki/Gallon#The_US_liquid_gallon here> for further information.
--
-- >>> 1 *~ usGallon
-- 3.785411784e-3 m^3
--
-- >>> 1 *~ usGallon :: Volume Rational
-- 473176473 % 125000000000 m^3
usGallon :: (Fractional a) => Unit 'NonMetric DVolume a
usGallon :: Unit 'NonMetric DVolume a
usGallon = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[gal_us]" String
"gal" String
"gallon") Rational
231 (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DLength a -> Unit 'NonMetric DVolume a
forall a (m :: Metricality).
(Fractional a, Typeable m) =>
Unit m DLength a -> Unit 'NonMetric DVolume a
cubic Unit 'NonMetric DLength a
forall a. Fractional a => Unit 'NonMetric DLength a
inch

-- | One US liquid quart is one quarter of a 'usGallon'.
--
-- See <https://en.wikipedia.org/wiki/United_States_customary_units#Fluid_volume here> for further information.
--
-- >>> 1 *~ usQuart
-- 9.46352946e-4 m^3
--
-- >>> 1 *~ usQuart :: Volume Rational
-- 473176473 % 500000000000 m^3
usQuart :: (Fractional a) => Unit 'NonMetric DVolume a
usQuart :: Unit 'NonMetric DVolume a
usQuart = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[qt_us]" String
"qt" String
"quart") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
4) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
usGallon

-- | One US liquid pint is one half of a 'usQuart'.
--
-- See <https://en.wikipedia.org/wiki/United_States_customary_units#Fluid_volume here> for further information.
--
-- >>> 1 *~ usPint
-- 4.73176473e-4 m^3
--
-- >>> 1 *~ usPint :: Volume Rational
-- 473176473 % 1000000000000 m^3
usPint :: (Fractional a) => Unit 'NonMetric DVolume a
usPint :: Unit 'NonMetric DVolume a
usPint = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[pt_us]" String
"pt" String
"pint") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
8) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
usGallon

-- | One US liquid cup is one half of a 'usPint'.
--
-- See <https://en.wikipedia.org/wiki/United_States_customary_units#Fluid_volume here> for further information.
--
-- >>> 1 *~ usCup
-- 2.365882365e-4 m^3
--
-- >>> 1 *~ usCup :: Volume Rational
-- 473176473 % 2000000000000 m^3
usCup :: (Fractional a) => Unit 'NonMetric DVolume a
usCup :: Unit 'NonMetric DVolume a
usCup = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[cup_us]" String
"cup" String
"cup") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
2) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
usPint

-- | One US liquid gill is one half of a 'usCup'.
--
-- See <https://en.wikipedia.org/wiki/United_States_customary_units#Fluid_volume here> for further information.
--
-- >>> 1 *~ usGill
-- 1.1829411825e-4 m^3
--
-- >>> 1 *~ usGill :: Volume Rational
-- 473176473 % 4000000000000 m^3
usGill :: (Fractional a) => Unit 'NonMetric DVolume a
usGill :: Unit 'NonMetric DVolume a
usGill = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[gil_us]" String
"gill" String
"gill") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
4) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
usPint

-- | One US fluid ounce is 1/128 'usGallon' or 1/8 'usCup'.
--
-- See <https://en.wikipedia.org/wiki/United_States_customary_units#Fluid_volume here> for further information.
--
-- >>> 1 *~ usFluidOunce
-- 2.95735295625e-5 m^3
--
-- >>> 1 *~ usFluidOunce :: Volume Rational
-- 473176473 % 16000000000000 m^3
usFluidOunce :: (Fractional a) => Unit 'NonMetric DVolume a
usFluidOunce :: Unit 'NonMetric DVolume a
usFluidOunce = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DVolume a
-> Unit 'NonMetric DVolume a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"[foz_us]" String
"fl oz" String
"fluid ounce") (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
Prelude./ Rational
16) (Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a)
-> Unit 'NonMetric DVolume a -> Unit 'NonMetric DVolume a
forall a b. (a -> b) -> a -> b
$ Unit 'NonMetric DVolume a
forall a. Fractional a => Unit 'NonMetric DVolume a
usPint -- sic, does not match factor used in imperial system

-- | One Ångström is 1/10 'nano' 'meter'.
--
-- See <https://en.wikipedia.org/wiki/%C3%85ngstr%C3%B6m here> for further information.
--
-- >>> 1 *~ angstrom
-- 1.0e-10 m
--
-- >>> 1 *~ angstrom :: Length Rational
-- 1 % 10000000000 m
angstrom :: (Fractional a) => Unit 'NonMetric DLength a
angstrom :: Unit 'NonMetric DLength a
angstrom = UnitName 'NonMetric
-> Rational
-> Unit 'NonMetric DLength a
-> Unit 'NonMetric DLength a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"Ao" String
"Å" String
"Ångström") Rational
0.1 (Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a)
-> Unit 'NonMetric DLength a -> Unit 'NonMetric DLength a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DLength a -> Unit 'NonMetric DLength a
forall a (d :: Dimension).
Fractional a =>
Unit 'Metric d a -> Unit 'NonMetric d a
nano Unit 'Metric DLength a
forall a. Num a => Unit 'Metric DLength a
meter

-- | One Gauss is 1/10000 'tesla'.
--
-- See <https://en.wikipedia.org/wiki/Gauss_%28unit%29 here> for further information.
--
-- >>> 1 *~ gauss
-- 1.0e-4 kg s^-2 A^-1
--
-- >>> 1 *~ gauss :: MagneticFluxDensity Rational
-- 1 % 10000 kg s^-2 A^-1
gauss :: (Fractional a) => Unit 'NonMetric DMagneticFluxDensity a
gauss :: Unit 'NonMetric DMagneticFluxDensity a
gauss = UnitName 'NonMetric
-> Rational
-> Unit 'Metric DMagneticFluxDensity a
-> Unit 'NonMetric DMagneticFluxDensity a
forall a (m :: Metricality) (m1 :: Metricality) (d :: Dimension).
Fractional a =>
UnitName m -> Rational -> Unit m1 d a -> Unit m d a
mkUnitQ (String -> String -> String -> UnitName 'NonMetric
ucum String
"G" String
"G" String
"Gauss") Rational
1e-4 (Unit 'Metric DMagneticFluxDensity a
 -> Unit 'NonMetric DMagneticFluxDensity a)
-> Unit 'Metric DMagneticFluxDensity a
-> Unit 'NonMetric DMagneticFluxDensity a
forall a b. (a -> b) -> a -> b
$ Unit 'Metric DMagneticFluxDensity a
forall a. Num a => Unit 'Metric DMagneticFluxDensity a
tesla