dimensional-1.0.1.3/benchmarks/0000755000000000000000000000000012627647654014502 5ustar0000000000000000dimensional-1.0.1.3/examples/0000755000000000000000000000000012641324764014171 5ustar0000000000000000dimensional-1.0.1.3/src/0000755000000000000000000000000012725324453013140 5ustar0000000000000000dimensional-1.0.1.3/src/Numeric/0000755000000000000000000000000012627647654014556 5ustar0000000000000000dimensional-1.0.1.3/src/Numeric/Units/0000755000000000000000000000000012766531473015653 5ustar0000000000000000dimensional-1.0.1.3/src/Numeric/Units/Dimensional/0000755000000000000000000000000012766531445020114 5ustar0000000000000000dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Dimensions/0000755000000000000000000000000012766531445022224 5ustar0000000000000000dimensional-1.0.1.3/src/Numeric/Units/Dimensional/UnitNames/0000755000000000000000000000000012766531445022017 5ustar0000000000000000dimensional-1.0.1.3/tests/0000755000000000000000000000000012766531445013521 5ustar0000000000000000dimensional-1.0.1.3/tests/Numeric/0000755000000000000000000000000012766531445015123 5ustar0000000000000000dimensional-1.0.1.3/tests/Numeric/Units/0000755000000000000000000000000012766531445016225 5ustar0000000000000000dimensional-1.0.1.3/tests/Numeric/Units/Dimensional/0000755000000000000000000000000012766531445020467 5ustar0000000000000000dimensional-1.0.1.3/src/Numeric/Units/Dimensional.hs0000644000000000000000000006643012766531473020462 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} -- for Vector instances only {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary In this module we provide data types for performing arithmetic with physical quantities and units. Information about the physical dimensions of the quantities/units is embedded in their types and the validity of operations is verified by the type checker at compile time. The boxing and unboxing of numerical values as quantities is done by multiplication and division of units, of which an incomplete set is provided. We limit ourselves to \"Newtonian\" physics. We do not attempt to accommodate relativistic physics in which e.g. addition of length and time would be valid. As far as possible and/or practical the conventions and guidelines of NIST's "Guide for the Use of the International System of Units (SI)" <#note1 [1]> are followed. Occasionally we will reference specific sections from the guide and deviations will be explained. == Disclaimer Merely an engineer, the author doubtlessly uses a language and notation that makes mathematicians and physicist cringe. He does not mind constructive criticism (or pull requests). The sets of functions and units defined herein are incomplete and reflect only the author's needs to date. Again, patches are welcome. = Usage == Preliminaries This module requires GHC 7.8 or later. We utilize Data Kinds, TypeNats, Closed Type Families, etc. Clients of the module are generally not required to use these extensions. Clients probably will want to use the NegativeLiterals extension. == Examples We have defined operators and units that allow us to define and work with physical quantities. A physical quantity is defined by multiplying a number with a unit (the type signature is optional). > v :: Velocity Prelude.Double > v = 90 *~ (kilo meter / hour) It follows naturally that the numerical value of a quantity is obtained by division by a unit. > numval :: Prelude.Double > numval = v /~ (meter / second) The notion of a quantity as the product of a numerical value and a unit is supported by 7.1 "Value and numerical value of a quantity" of <#note1 [1]>. While the above syntax is fairly natural it is unfortunate that it must violate a number of the guidelines in <#note1 [1]>, in particular 9.3 "Spelling unit names with prefixes", 9.4 "Spelling unit names obtained by multiplication", 9.5 "Spelling unit names obtained by division". As a more elaborate example of how to use the module we define a function for calculating the escape velocity of a celestial body <#note2 [2]>. > escapeVelocity :: (Floating a) => Mass a -> Length a -> Velocity a > escapeVelocity m r = sqrt (two * g * m / r) > where > two = 2 *~ one > g = 6.6720e-11 *~ (newton * meter ^ pos2 / kilo gram ^ pos2) The following is an example GHC session where the above function is used to calculate the escape velocity of Earth in kilometer per second. >>> :set +t >>> let me = 5.9742e24 *~ kilo gram -- Mass of Earth. me :: Quantity DMass GHC.Float.Double >>> let re = 6372.792 *~ kilo meter -- Mean radius of Earth. re :: Quantity DLength GHC.Float.Double >>> let ve = escapeVelocity me re -- Escape velocity of Earth. ve :: Velocity GHC.Float.Double >>> ve /~ (kilo meter / second) 11.184537332296259 it :: GHC.Float.Double For completeness we should also show an example of the error messages we will get from GHC when performing invalid arithmetic. In the best case GHC will be able to use the type synonyms we have defined in its error messages. >>> x = 1 *~ meter + 1 *~ second Couldn't match type 'Numeric.NumType.DK.Integers.Zero with 'Numeric.NumType.DK.Integers.Pos1 Expected type: Unit 'Metric DLength a Actual type: Unit 'Metric DTime a In the second argument of `(*~)', namely `second' In the second argument of `(+)', namely `1 *~ second' In other cases the error messages aren't very friendly. >>> x = 1 *~ meter / (1 *~ second) + 1 *~ kilo gram Couldn't match type 'Numeric.NumType.DK.Integers.Zero with 'Numeric.NumType.DK.Integers.Neg1 Expected type: Quantity DMass a Actual type: Dimensional ('Numeric.Units.Dimensional.Variants.DQuantity Numeric.Units.Dimensional.Variants.* 'Numeric.Units.Dimensional.Variants.DQuantity) (DLength / DTime) a In the first argument of `(+)', namely `1 *~ meter / (1 *~ second)' In the expression: 1 *~ meter / (1 *~ second) + 1 *~ kilo gram In an equation for `x': x = 1 *~ meter / (1 *~ second) + 1 *~ kilo gram It is the author's experience that the usefullness of the compiler error messages is more often than not limited to pinpointing the location of errors. = Notes == Future work While there is an insane amount of units in use around the world it is reasonable to provide at least all SI units. Units outside of SI will most likely be added on an as-needed basis. There are also plenty of elementary functions to add. The 'Floating' class can be used as reference. Additional physics models could be implemented. See <#note3 [3]> for ideas. == Related work Henning Thielemann numeric prelude has a physical units library, however, checking of dimensions is dynamic rather than static. Aaron Denney has created a toy example of statically checked physical dimensions covering only length and time. HaskellWiki has pointers <#note4 [4]> to these. Also see Samuel Hoffstaetter's blog post <#note5 [5]> which uses techniques similar to this library. Libraries with similar functionality exist for other programming languages and may serve as inspiration. The author has found the Java library JScience <#note6 [6]> and the Fortress programming language <#note7 [7]> particularly noteworthy. == References 1. #note1# http://physics.nist.gov/Pubs/SP811/ 2. #note2# http://en.wikipedia.org/wiki/Escape_velocity 3. #note3# http://jscience.org/api/org/jscience/physics/models/package-summary.html 4. #note4# http://www.haskell.org/haskellwiki/Physical_units 5. #note5# http://liftm.wordpress.com/2007/06/03/scientificdimension-type-arithmetic-and-physical-units-in-haskell/ 6. #note6# http://jscience.org/ 7. #note7# http://research.sun.com/projects/plrg/fortress.pdf -} module Numeric.Units.Dimensional ( -- * Types -- $types Dimensional, Unit, Quantity, Metricality(..), -- * Physical Dimensions -- $dimensions Dimension (Dim), -- ** Dimension Arithmetic -- $dimension-arithmetic type (*), type (/), type (^), Root, Recip, -- ** Term Level Representation of Dimensions -- $dimension-terms Dimension' (Dim'), HasDimension(..), KnownDimension, -- * Dimensional Arithmetic (*~), (/~), (^), (^/), (**), (*), (/), (+), (-), negate, abs, nroot, sqrt, cbrt, -- ** Transcendental Functions exp, log, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh, atan2, -- ** Operations on Collections -- $collections (*~~), (/~~), sum, mean, dimensionlessLength, nFromTo, -- * Dimension Synonyms -- $dimension-synonyms DOne, DLength, DMass, DTime, DElectricCurrent, DThermodynamicTemperature, DAmountOfSubstance, DLuminousIntensity, -- * Quantity Synonyms -- $quantity-synonyms Dimensionless, Length, Mass, Time, ElectricCurrent, ThermodynamicTemperature, AmountOfSubstance, LuminousIntensity, -- * Constants -- $constants _0, _1, _2, _3, _4, _5, _6, _7, _8, _9, pi, tau, -- * Constructing Units siUnit, one, mkUnitR, mkUnitQ, mkUnitZ, -- * Unit Metadata name, exactValue, weaken, strengthen, exactify, -- * Pretty Printing showIn, -- * On 'Functor', and Conversion Between Number Representations -- $functor KnownVariant(dmap), changeRep, changeRepApproximate ) where import Prelude ( Eq(..), Num, Fractional, Floating, Real, RealFloat, Functor, fmap , (.), flip, (++), fromIntegral, fromInteger, fromRational, error, max, succ , Int, Integer, Integral, ($), uncurry, realToFrac, otherwise ) import qualified Prelude import Numeric.NumType.DK.Integers ( TypeInt (Pos2, Pos3) , pos2, pos3 , KnownTypeInt, toNum ) import Data.Data import Data.ExactPi import Data.Foldable (Foldable(foldr, foldl')) import Data.Maybe import Data.Ratio import Numeric.Units.Dimensional.Dimensions import Numeric.Units.Dimensional.Internal import Numeric.Units.Dimensional.UnitNames hiding ((*), (/), (^), weaken, strengthen) import qualified Numeric.Units.Dimensional.UnitNames.Internal as Name import Numeric.Units.Dimensional.Variants hiding (type (*)) import qualified Numeric.Units.Dimensional.Variants as V {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixr 8 ^, ^/, ** infixl 7 *, / infixl 6 +, - {- $types Our primary objective is to define a data type that can be used to represent (while still differentiating between) units and quantities. There are two reasons for consolidating units and quantities in one data type. The first being to allow code reuse as they are largely subject to the same operations. The second being that it allows reuse of operators (and functions) between the two without resorting to occasionally cumbersome type classes. The relationship between (the value of) a 'Quantity', its numerical value and its 'Unit' is described in 7.1 "Value and numerical value of a quantity" of <#note1 [1]>. In short a 'Quantity' is the product of a number and a 'Unit'. We define the '*~' operator as a convenient way to declare quantities as such a product. -} -- | Extracts the 'UnitName' of a 'Unit'. name :: Unit m d a -> UnitName m name (Unit n _ _) = n -- | Extracts the exact value of a 'Unit', expressed in terms of the SI coherent derived unit (see 'siUnit') of the same 'Dimension'. -- -- Note that the actual value may in some cases be approximate, for example if the unit is defined by experiment. exactValue :: Unit m d a -> ExactPi exactValue (Unit _ e _) = e -- | Discards potentially unwanted type level information about a 'Unit'. weaken :: Unit m d a -> Unit 'NonMetric d a weaken (Unit n e v) = Unit (Name.weaken n) e v -- | Attempts to convert a 'Unit' which may or may not be 'Metric' to one -- which is certainly 'Metric'. strengthen :: Unit m d a -> Maybe (Unit 'Metric d a) strengthen (Unit n e v) | Just n' <- Name.strengthen n = Just $ Unit n' e v | otherwise = Nothing -- | Forms the exact version of a 'Unit'. exactify :: Unit m d a -> Unit m d ExactPi exactify (Unit n e _) = Unit n e e -- | Forms a 'Quantity' by multipliying a number and a unit. (*~) :: Num a => a -> Unit m d a -> Quantity d a x *~ (Unit _ _ y) = Quantity (x Prelude.* y) -- | Divides a 'Quantity' by a 'Unit' of the same physical dimension, obtaining the -- numerical value of the quantity expressed in that unit. (/~) :: Fractional a => Quantity d a -> Unit m d a -> a (Quantity x) /~ (Unit _ _ y) = (x Prelude./ y) {- We give '*~' and '/~' the same fixity as '*' and '/' defined below. Note that this necessitates the use of parenthesis when composing units using '*' and '/', e.g. "1 *~ (meter / second)". -} infixl 7 *~, /~ {- $dimensions The phantom type variable d encompasses the physical dimension of a 'Dimensional'. As detailed in <#note5 [5]> there are seven base dimensions, which can be combined in integer powers to a given physical dimension. We represent physical dimensions as the powers of the seven base dimensions that make up the given dimension. The powers are represented using NumTypes. For convenience we collect all seven base dimensions in a data kind 'Dimension'. We could have chosen to provide type variables for the seven base dimensions in 'Dimensional' instead of creating a new data kind 'Dimension'. However, that would have made any type signatures involving 'Dimensional' very cumbersome. By encompassing the physical dimension in a single type variable we can "hide" the cumbersome type arithmetic behind convenient type classes as will be seen later. -} {- $dimension-synonyms Using our 'Dimension' data kind we define some type synonyms for convenience. We start with the base dimensions, others can be found in "Numeric.Units.Dimensional.Quantities". -} {- $quantity-synonyms Using the above type synonyms we can define type synonyms for quantities of particular physical dimensions. Again we limit ourselves to the base dimensions, others can be found in "Numeric.Units.Dimensional.Quantities". -} type Dimensionless = Quantity DOne type Length = Quantity DLength type Mass = Quantity DMass type Time = Quantity DTime type ElectricCurrent = Quantity DElectricCurrent type ThermodynamicTemperature = Quantity DThermodynamicTemperature type AmountOfSubstance = Quantity DAmountOfSubstance type LuminousIntensity = Quantity DLuminousIntensity {- $dimension-arithmetic When performing arithmetic on units and quantities the arithmetics must be applied to both the numerical values of the Dimensionals but also to their physical dimensions. The type level arithmetic on physical dimensions is governed by closed type families expressed as type operators. We could provide the 'Mul' and 'Div' classes with full functional dependencies but that would be of limited utility as there is no limited use for "backwards" type inference. Efforts are underway to develop a type-checker plugin that does enable these scenarios, e.g. for linear algebra. -} {- = Arithmetic on units and quantities = Thanks to the arithmetic on physical dimensions having been sorted out separately a lot of the arithmetic on Dimensionals is straight forward. In particular the type signatures are much simplified. Multiplication, division and powers apply to both units and quantities. -} -- | Multiplies two 'Quantity's or two 'Unit's. -- -- The intimidating type signature captures the similarity between these operations -- and ensures that composite 'Unit's are 'NonMetric'. (*) :: (KnownVariant v1, KnownVariant v2, KnownVariant (v1 V.* v2), Num a) => Dimensional v1 d1 a -> Dimensional v2 d2 a -> Dimensional (v1 V.* v2) (d1 * d2) a (*) = liftD2 (Prelude.*) (Prelude.*) (Name.*) -- | Divides one 'Quantity' by another or one 'Unit' by another. -- -- The intimidating type signature captures the similarity between these operations -- and ensures that composite 'Unit's are 'NotPrefixable'. (/) :: (KnownVariant v1, KnownVariant v2, KnownVariant (v1 V.* v2), Fractional a) => Dimensional v1 d1 a -> Dimensional v2 d2 a -> Dimensional (v1 V.* v2) (d1 / d2) a (/) = liftD2 (Prelude./) (Prelude./) (Name./) -- | Raises a 'Quantity' or 'Unit' to an integer power. -- -- Because the power chosen impacts the 'Dimension' of the result, it is necessary to supply a type-level representation -- of the exponent in the form of a 'Proxy' to some 'TypeInt'. Convenience values 'pos1', 'pos2', 'neg1', ... -- are supplied by the "Numeric.NumType.DK.Integers" module. The most commonly used ones are -- also reexported by "Numeric.Units.Dimensional.Prelude". -- -- The intimidating type signature captures the similarity between these operations -- and ensures that composite 'Unit's are 'NotPrefixable'. (^) :: (Fractional a, KnownTypeInt i, KnownVariant v, KnownVariant (Weaken v)) => Dimensional v d1 a -> Proxy i -> Dimensional (Weaken v) (d1 ^ i) a x ^ n = let n' = (toNum n) :: Int in liftD (Prelude.^^ n') (Prelude.^^ n') (Name.^ n') x {- A special case is that dimensionless quantities are not restricted to integer exponents. This is accommodated by the '**' operator defined later. = Quantity operations = Some additional operations obviously only make sense for quantities. Of these, negation, addition and subtraction are particularly simple as they are done in a single physical dimension. -} -- | Negates the value of a 'Quantity'. negate :: Num a => Quantity d a -> Quantity d a negate = liftQ Prelude.negate -- | Adds two 'Quantity's. (+) :: Num a => Quantity d a -> Quantity d a -> Quantity d a (+) = liftQ2 (Prelude.+) -- | Subtracts one 'Quantity' from another. (-) :: Num a => Quantity d a -> Quantity d a -> Quantity d a (-) = liftQ2 (Prelude.-) -- | Takes the absolute value of a 'Quantity'. abs :: Num a => Quantity d a -> Quantity d a abs = liftQ Prelude.abs {- Roots of arbitrary (integral) degree. Appears to occasionally be useful for units as well as quantities. -} -- | Computes the nth root of a 'Quantity' using 'Prelude.**'. -- -- The 'Root' type family will prevent application of this operator where the result would have a fractional dimension or where n is zero. -- -- Because the root chosen impacts the 'Dimension' of the result, it is necessary to supply a type-level representation -- of the root in the form of a 'Proxy' to some 'TypeInt'. Convenience values 'pos1', 'pos2', 'neg1', ... -- are supplied by the "Numeric.NumType.DK.Integers" module. The most commonly used ones are -- also reexported by "Numeric.Units.Dimensional.Prelude". -- -- Also available in operator form, see '^/'. nroot :: (KnownTypeInt n, Floating a) => Proxy n -> Quantity d a -> Quantity (Root d n) a nroot n = let n' = 1 Prelude./ toNum n in liftQ (Prelude.** n') {- We provide short-hands for the square and cubic roots. -} -- | Computes the square root of a 'Quantity' using 'Prelude.**'. -- -- The 'Root' type family will prevent application where the supplied quantity does not have a square dimension. -- -- prop> sqrt x == nroot pos2 x sqrt :: Floating a => Quantity d a -> Quantity (Root d 'Pos2) a sqrt = nroot pos2 -- | Computes the cube root of a 'Quantity' using 'Prelude.**'. -- -- The 'Root' type family will prevent application where the supplied quantity does not have a cubic dimension. -- -- prop> cbrt x == nroot pos3 x cbrt :: Floating a => Quantity d a -> Quantity (Root d 'Pos3) a cbrt = nroot pos3 {- We also provide an operator alternative to nroot for those that prefer such. -} -- | Computes the nth root of a 'Quantity' using 'Prelude.**'. -- -- The 'Root' type family will prevent application of this operator where the result would have a fractional dimension or where n is zero. -- -- Because the root chosen impacts the 'Dimension' of the result, it is necessary to supply a type-level representation -- of the root in the form of a 'Proxy' to some 'TypeInt'. Convenience values 'pos1', 'pos2', 'neg1', ... -- are supplied by the "Numeric.NumType.DK.Integers" module. The most commonly used ones are -- also reexported by "Numeric.Units.Dimensional.Prelude". -- -- Also available in prefix form, see 'nroot'. (^/) :: (KnownTypeInt n, Floating a) => Quantity d a -> Proxy n -> Quantity (Root d n) a (^/) = flip nroot {- $collections Here we define operators and functions to make working with homogenuous lists of dimensionals more convenient. We define two convenience operators for applying units to all elements of a functor (e.g. a list). -} -- | Applies '*~' to all values in a functor. (*~~) :: (Functor f, Num a) => f a -> Unit m d a -> f (Quantity d a) xs *~~ u = fmap (*~ u) xs -- | Applies '/~' to all values in a functor. (/~~) :: (Functor f, Fractional a) => f (Quantity d a) -> Unit m d a -> f a xs /~~ u = fmap (/~ u) xs infixl 7 *~~, /~~ -- | The sum of all elements in a list. sum :: (Num a, Foldable f) => f (Quantity d a) -> Quantity d a sum = foldr (+) _0 -- | The arithmetic mean of all elements in a list. mean :: (Fractional a, Foldable f) => f (Quantity d a) -> Quantity d a mean = uncurry (/) . foldr accumulate (_0, _0) where accumulate val (accum, count) = (accum + val, count + _1) -- | The length of the foldable data structure as a 'Dimensionless'. -- This can be useful for purposes of e.g. calculating averages. dimensionlessLength :: (Num a, Foldable f) => f (Dimensional v d a) -> Dimensionless a dimensionlessLength x = (fromIntegral $ length x) *~ one where -- As in base-4.8 Data.Foldable for GHC 7.8 (base-4.6) compatibility. -- Once base-4.6. compatibility is abandoned this where clause can -- be deleted (and imports adjusted). length :: Foldable t => t a -> Int length = foldl' (\c _ -> c Prelude.+ 1) 0 -- | Returns a list of quantities between given bounds. nFromTo :: (Fractional a, Integral b) => Quantity d a -- ^ The initial value. -> Quantity d a -- ^ The final value. -> b -- ^ The number of intermediate values. If less than one, no intermediate values will result. -> [Quantity d a] nFromTo xi xf n = fmap f [0..n'] ++ [xf] where n' = max 0 n f i = xi + realToFrac (i % succ n') *~ one * (xf - xi) {- We continue by defining elementary functions on 'Dimensionless' that may be obviously useful. -} exp, log, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh :: Floating a => Dimensionless a -> Dimensionless a exp = fmap Prelude.exp log = fmap Prelude.log sin = fmap Prelude.sin cos = fmap Prelude.cos tan = fmap Prelude.tan asin = fmap Prelude.asin acos = fmap Prelude.acos atan = fmap Prelude.atan sinh = fmap Prelude.sinh cosh = fmap Prelude.cosh tanh = fmap Prelude.tanh asinh = fmap Prelude.asinh acosh = fmap Prelude.acosh atanh = fmap Prelude.atanh -- | Raises a dimensionless quantity to a floating power using 'Prelude.**'. (**) :: Floating a => Dimensionless a -> Dimensionless a -> Dimensionless a (**) = liftQ2 (Prelude.**) -- | The standard two argument arctangent function. -- Since it interprets its two arguments in comparison with one another, the input may have any dimension. atan2 :: (RealFloat a) => Quantity d a -> Quantity d a -> Dimensionless a atan2 = liftQ2 Prelude.atan2 {- The only unit we will define in this module is 'one'. -} -- | The unit 'one' has dimension 'DOne' and is the base unit of dimensionless values. -- -- As detailed in 7.10 "Values of quantities expressed simply as numbers: -- the unit one, symbol 1" of <#note1 [1]> the unit one generally does not -- appear in expressions. However, for us it is necessary to use 'one' -- as we would any other unit to perform the "boxing" of dimensionless values. one :: Num a => Unit 'NonMetric DOne a one = Unit nOne 1 1 {- $constants For convenience we define some constants for small integer values that often show up in formulae. We also throw in 'pi' and 'tau' for good measure. -} -- | The constant for zero is polymorphic, allowing -- it to express zero 'Length' or 'Capacitance' or 'Velocity' etc, in addition -- to the 'Dimensionless' value zero. _0 :: Num a => Quantity d a _0 = Quantity 0 _1, _2, _3, _4, _5, _6, _7, _8, _9 :: (Num a) => Dimensionless a _1 = 1 *~ one _2 = 2 *~ one _3 = 3 *~ one _4 = 4 *~ one _5 = 5 *~ one _6 = 6 *~ one _7 = 7 *~ one _8 = 8 *~ one _9 = 9 *~ one pi :: Floating a => Dimensionless a pi = Prelude.pi *~ one -- | Twice 'pi'. -- -- For background on 'tau' see http://tauday.com/tau-manifesto (but also -- feel free to review http://www.thepimanifesto.com). tau :: Floating a => Dimensionless a tau = _2 * pi {- $functor We intentionally decline to provide a 'Functor' instance for 'Dimensional' because its use breaks the abstraction of physical dimensions. If you feel your work requires this instance, it is provided as an orphan in "Numeric.Units.Dimensional.Functor". -} -- | Convenient conversion between numerical types while retaining dimensional information. changeRep :: (KnownVariant v, Real a, Fractional b) => Dimensional v d a -> Dimensional v d b changeRep = dmap realToFrac -- | Convenient conversion from exactly represented values while retaining dimensional information. changeRepApproximate :: (KnownVariant v, Floating b) => Dimensional v d ExactPi -> Dimensional v d b changeRepApproximate = dmap approximateValue {- $dimension-terms To facilitate parsing and pretty-printing functions that may wish to operate on term-level representations of dimension, we provide a means for converting from type-level dimensions to term-level dimensions. -} -- | Forms a new atomic 'Unit' by specifying its 'UnitName' and its definition as a multiple of another 'Unit'. -- -- Use this variant when the scale factor of the resulting unit is irrational or 'Approximate'. See 'mkUnitQ' for when it is rational -- and 'mkUnitZ' for when it is an integer. -- -- Note that supplying zero as a definining quantity is invalid, as the library relies -- upon units forming a group under multiplication. -- -- Supplying negative defining quantities is allowed and handled gracefully, but is discouraged -- on the grounds that it may be unexpected by other readers. mkUnitR :: Floating a => UnitName m -> ExactPi -> Unit m1 d a -> Unit m d a mkUnitR n s (Unit _ e _) | isExactZero s = error "Supplying zero as a conversion factor is not valid." | otherwise = Unit n e' x' where e' = s Prelude.* e x' = approximateValue e' -- | Forms a new atomic 'Unit' by specifying its 'UnitName' and its definition as a multiple of another 'Unit'. -- -- Use this variant when the scale factor of the resulting unit is rational. See 'mkUnitZ' for when it is an integer -- and 'mkUnitR' for the general case. -- -- For more information see 'mkUnitR'. mkUnitQ :: Fractional a => UnitName m -> Rational -> Unit m1 d a -> Unit m d a mkUnitQ n s (Unit _ e x) | s == 0 = error "Supplying zero as a conversion factor is not valid." | Just x'' <- toExactRational e' = Unit n e' (fromRational x'') | otherwise = Unit n e' x' where e' = fromRational s Prelude.* e x' = fromRational s Prelude.* x -- | Forms a new atomic 'Unit' by specifying its 'UnitName' and its definition as a multiple of another 'Unit'. -- -- Use this variant when the scale factor of the resulting unit is an integer. See 'mkUnitQ' for when it is rational -- and 'mkUnitR' for the general case. -- -- For more information see 'mkUnitR'. mkUnitZ :: Num a => UnitName m -> Integer -> Unit m1 d a -> Unit m d a mkUnitZ n s (Unit _ e x) | s == 0 = error "Supplying zero as a conversion factor is not valid." | Just x'' <- toExactInteger e' = Unit n e' (fromInteger x'') | otherwise = Unit n e' x' where e' = fromInteger s Prelude.* e x' = fromInteger s Prelude.* x dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Coercion.hs0000644000000000000000000000170712766531445022216 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2014 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Experimental Portability: GHC only? Re-exports the raw 'Quantity' constructor from the Numeric.Units.Dimensional.Internal module, along with 'Data.Coerce.coerce', for convenience in converting between raw representations and dimensional values. Note that use of these constructs requires the user to verify the dimensional safety of the conversion, because the coercion doesn't explicitly mention the unit of the representation. Note that the haddock documentation doesn't mention the 'Quantity' constructor because it is a part of the 'Dimensional' associated data family, but it is exported by this module. -} module Numeric.Units.Dimensional.Coercion ( coerce, Dimensional(Quantity) ) where import Data.Coerce (coerce) import Numeric.Units.Dimensional.Internal (Dimensional(Quantity)) dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Prelude.hs0000644000000000000000000000273512766531445022057 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary This module supplies a convenient set of imports for working with the dimensional package, including aliases for common 'Quantity's and 'Dimension's, and a comprehensive set of SI units and units accepted for use with the SI. It re-exports the "Prelude", hiding arithmetic functions whose names collide with the dimensionally-typed versions supplied by this package. -} module Numeric.Units.Dimensional.Prelude ( module Numeric.Units.Dimensional , module Numeric.Units.Dimensional.Quantities , module Numeric.Units.Dimensional.SIUnits , module Numeric.NumType.DK.Integers , module Data.Foldable , module Prelude ) where import Numeric.Units.Dimensional hiding ( dmap ) import Numeric.Units.Dimensional.Quantities import Numeric.Units.Dimensional.SIUnits import Numeric.NumType.DK.Integers ( neg5, neg4, neg3, neg2, neg1, zero, pos1, pos2, pos3, pos4, pos5 ) -- Used in exponents. import Data.Foldable ( product, minimum, maximum ) import Prelude hiding ( (+), (-), (*), (/), (^), (**) , abs, negate, pi, exp, log, sqrt , sin, cos, tan, asin, acos, atan, atan2 , sinh, cosh, tanh, asinh, acosh, atanh , sum, product, minimum, maximum ) -- Hide definitions overridden by 'Numeric.Dimensional'. dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Quantities.hs0000644000000000000000000004127212766531445022604 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE DataKinds #-} {- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary This module defines type synonyms for common dimensionalities and the associated quantity types. Additional dimensionalities and quantity types will be added on an as-needed basis. The definitions in this module are grouped so that a type synonym for the dimensionality is defined first in terms of base dimension exponents. Then a type synonym for the corresponding quantity type is defined. If there are several quantity types with the same dimensionality type synonyms are provided for each quantity type. = References 1. #note1# http://physics.nist.gov/Pubs/SP811/ -} module Numeric.Units.Dimensional.Quantities ( -- * Quantities from the NIST Guide -- $nist-guide Area, Volume, Velocity, Acceleration, WaveNumber, MassDensity, Density, SpecificVolume, CurrentDensity, MagneticFieldStrength, AmountOfSubstanceConcentration, Concentration, Luminance, -- $table3 PlaneAngle, SolidAngle, Frequency, Force, Pressure, Stress, Energy, Work, QuantityOfHeat, Power, RadiantFlux, ElectricCharge, QuantityOfElectricity, ElectricPotential, PotentialDifference, ElectromotiveForce, Capacitance, ElectricResistance, ElectricConductance, MagneticFlux, MagneticFluxDensity, Inductance, LuminousFlux, Illuminance, CelsiusTemperature, Activity, AbsorbedDose, SpecificEnergy, Kerma, DoseEquivalent, AmbientDoseEquivalent, DirectionalDoseEquivalent, PersonalDoseEquivalent, EquivalentDose, CatalyticActivity, -- $table4 AngularVelocity, AngularAcceleration, DynamicViscosity, MomentOfForce, SurfaceTension, HeatFluxDensity, Irradiance, RadiantIntensity, Radiance, HeatCapacity, Entropy, SpecificHeatCapacity, SpecificEntropy, ThermalConductivity, EnergyDensity, ElectricFieldStrength, ElectricChargeDensity, ElectricFluxDensity, Permittivity, Permeability, MolarEnergy, MolarEntropy, MolarHeatCapacity, Exposure, AbsorbedDoseRate, -- * Quantities not from the NIST Guide -- $not-nist-guide Impulse, Momentum, MassFlow, VolumeFlow, GravitationalParameter, KinematicViscosity, FirstMassMoment, MomentOfInertia, AngularMomentum, ThermalResistivity, ThermalConductance, ThermalResistance, HeatTransferCoefficient, ThermalAdmittance, ThermalInsulance, Jerk, Angle, Thrust, Torque, EnergyPerUnitMass, -- * Powers of Unit Lengths -- $powers-of-length-units square, cubic, -- * Dimension Aliases -- $dimension-aliases DArea, DVolume, DVelocity, DAcceleration, DWaveNumber, DMassDensity, DDensity, DSpecificVolume, DCurrentDensity, DMagneticFieldStrength, DAmountOfSubstanceConcentration, DConcentration, DLuminance, DPlaneAngle, DSolidAngle, DFrequency, DForce, DPressure, DStress, DEnergy, DWork, DQuantityOfHeat, DPower, DRadiantFlux, DElectricCharge, DQuantityOfElectricity, DElectricPotential, DPotentialDifference, DElectromotiveForce, DCapacitance, DElectricResistance, DElectricConductance, DMagneticFlux, DMagneticFluxDensity, DInductance, DLuminousFlux, DIlluminance, DCelsiusTemperature, DActivity, DAbsorbedDose, DSpecificEnergy, DKerma, DDoseEquivalent, DAmbientDoseEquivalent, DDirectionalDoseEquivalent, DPersonalDoseEquivalent, DEquivalentDose, DCatalyticActivity, DAngularVelocity, DAngularAcceleration, DDynamicViscosity, DMomentOfForce, DSurfaceTension, DHeatFluxDensity, DIrradiance, DRadiantIntensity, DRadiance, DHeatCapacity, DEntropy, DSpecificHeatCapacity, DSpecificEntropy, DThermalConductivity, DEnergyDensity, DElectricFieldStrength, DElectricChargeDensity, DElectricFluxDensity, DPermittivity, DPermeability, DMolarEnergy, DMolarEntropy, DMolarHeatCapacity, DExposure, DAbsorbedDoseRate, DImpulse, DMomentum, DMassFlow, DVolumeFlow, DGravitationalParameter, DKinematicViscosity, DFirstMassMoment, DMomentOfInertia, DAngularMomentum, DThermalResistivity, DThermalConductance, DThermalResistance, DHeatTransferCoefficient, DThermalAdmittance, DThermalInsulance, DJerk, DAngle, DThrust, DTorque, DEnergyPerUnitMass ) where import Numeric.Units.Dimensional ( Dimension (Dim), Quantity, Dimensionless , DOne, DLuminousIntensity, DThermodynamicTemperature , Unit, DLength, (^) -- Used only for 'square' and 'cubic'. , Metricality(..) ) import Numeric.NumType.DK.Integers ( TypeInt (Neg3, Neg2, Neg1, Zero, Pos1, Pos2, Pos3, Pos4) , pos2, pos3 -- Used only for 'square' and 'cubic'. ) import Prelude (Fractional) import Data.Typeable {- $nist-guide The following quantities are all from the NIST publication "Guide for the Use of the International System of Units (SI)" <#note1 [1]>. Any chapters, sections or tables referenced are from <#note1 [1]> unless otherwise specified. For lack of better organization we provide definitions grouped by table in <#note1 [1]>. == Table 2 "Examples of SI derived units expressed in terms of SI base units." -} {- $dimension-aliases For each 'Quantity' alias supplied above, we also supply a corresponding 'Dimension' alias. These dimension aliases may be convenient for supplying type signatures for 'Unit's or for other type-level dimensional programming. -} type DArea = 'Dim 'Pos2 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type Area = Quantity DArea type DVolume = 'Dim 'Pos3 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type Volume = Quantity DVolume type DVelocity = 'Dim 'Pos1 'Zero 'Neg1 'Zero 'Zero 'Zero 'Zero type Velocity = Quantity DVelocity type DAcceleration = 'Dim 'Pos1 'Zero 'Neg2 'Zero 'Zero 'Zero 'Zero type Acceleration = Quantity DAcceleration type DWaveNumber = 'Dim 'Neg1 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type WaveNumber = Quantity DWaveNumber type DMassDensity = 'Dim 'Neg3 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero type DDensity = DMassDensity type MassDensity = Quantity DMassDensity type Density = MassDensity -- Short name. type DSpecificVolume = 'Dim 'Pos3 'Neg1 'Zero 'Zero 'Zero 'Zero 'Zero type SpecificVolume = Quantity DSpecificVolume type DCurrentDensity = 'Dim 'Neg2 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero type CurrentDensity = Quantity DCurrentDensity type DMagneticFieldStrength = 'Dim 'Neg1 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero type MagneticFieldStrength = Quantity DMagneticFieldStrength type DAmountOfSubstanceConcentration = 'Dim 'Neg3 'Zero 'Zero 'Zero 'Zero 'Pos1 'Zero type DConcentration = DAmountOfSubstanceConcentration type AmountOfSubstanceConcentration = Quantity DAmountOfSubstanceConcentration type Concentration = AmountOfSubstanceConcentration -- Short name. type DLuminance = 'Dim 'Neg2 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 type Luminance = Quantity DLuminance {- $table3 == Table 3 SI coherent derived units with special names and symbols. -} type DPlaneAngle = DOne type PlaneAngle = Dimensionless type DSolidAngle = DOne type SolidAngle = Dimensionless type DFrequency = 'Dim 'Zero 'Zero 'Neg1 'Zero 'Zero 'Zero 'Zero type Frequency = Quantity DFrequency type DForce = 'Dim 'Pos1 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero type Force = Quantity DForce type DPressure = 'Dim 'Neg1 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero type DStress = DPressure type Pressure = Quantity DPressure type Stress = Quantity DStress type DEnergy = 'Dim 'Pos2 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero type DWork = DEnergy type DQuantityOfHeat = DEnergy type Energy = Quantity DEnergy type Work = Quantity DWork type QuantityOfHeat = Quantity DQuantityOfHeat type DPower = 'Dim 'Pos2 'Pos1 'Neg3 'Zero 'Zero 'Zero 'Zero type DRadiantFlux = DPower type Power = Quantity DPower type RadiantFlux = Quantity DRadiantFlux type DElectricCharge = 'Dim 'Zero 'Zero 'Pos1 'Pos1 'Zero 'Zero 'Zero type DQuantityOfElectricity = DElectricCharge type ElectricCharge = Quantity DElectricCharge type QuantityOfElectricity = Quantity DQuantityOfElectricity type DElectricPotential = 'Dim 'Pos2 'Pos1 'Neg3 'Neg1 'Zero 'Zero 'Zero type DPotentialDifference = DElectricPotential type DElectromotiveForce = DElectricPotential type ElectricPotential = Quantity DElectricPotential type PotentialDifference = Quantity DPotentialDifference type ElectromotiveForce = Quantity DElectromotiveForce type DCapacitance = 'Dim 'Neg2 'Neg1 'Pos4 'Pos2 'Zero 'Zero 'Zero type Capacitance = Quantity DCapacitance type DElectricResistance = 'Dim 'Pos2 'Pos1 'Neg3 'Neg2 'Zero 'Zero 'Zero type ElectricResistance = Quantity DElectricResistance type DElectricConductance = 'Dim 'Neg2 'Neg1 'Pos3 'Pos2 'Zero 'Zero 'Zero type ElectricConductance = Quantity DElectricConductance type DMagneticFlux = 'Dim 'Pos2 'Pos1 'Neg2 'Neg1 'Zero 'Zero 'Zero type MagneticFlux = Quantity DMagneticFlux type DMagneticFluxDensity = 'Dim 'Zero 'Pos1 'Neg2 'Neg1 'Zero 'Zero 'Zero type MagneticFluxDensity = Quantity DMagneticFluxDensity type DInductance = 'Dim 'Pos2 'Pos1 'Neg2 'Neg2 'Zero 'Zero 'Zero type Inductance = Quantity DInductance type DLuminousFlux = DLuminousIntensity type LuminousFlux = Quantity DLuminousFlux type DIlluminance = 'Dim 'Neg2 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 type Illuminance = Quantity DIlluminance type DCelsiusTemperature = DThermodynamicTemperature type CelsiusTemperature = Quantity DCelsiusTemperature type DActivity = DFrequency -- Activity of a radionuclide. type Activity = Quantity DActivity type DAbsorbedDose = 'Dim 'Pos2 'Zero 'Neg2 'Zero 'Zero 'Zero 'Zero type DSpecificEnergy = DAbsorbedDose type DKerma = DAbsorbedDose type AbsorbedDose = Quantity DAbsorbedDose type SpecificEnergy = Quantity DSpecificEnergy -- Specific energy imparted. type Kerma = Quantity DKerma type DDoseEquivalent = DAbsorbedDose type DAmbientDoseEquivalent = DDoseEquivalent type DDirectionalDoseEquivalent = DDoseEquivalent type DPersonalDoseEquivalent = DDoseEquivalent type DEquivalentDose = DDoseEquivalent type DoseEquivalent = Quantity DDoseEquivalent type AmbientDoseEquivalent = DoseEquivalent type DirectionalDoseEquivalent = DoseEquivalent type PersonalDoseEquivalent = DoseEquivalent type EquivalentDose = DoseEquivalent type DCatalyticActivity = 'Dim 'Zero 'Zero 'Neg1 'Zero 'Zero 'Pos1 'Zero type CatalyticActivity = Quantity DCatalyticActivity {- $table4 == Table 4 "Examples of SI coherent derived units expressed with the aid of SI derived units having special names and symbols." We use the same grouping as for table 2. -} type DAngularVelocity = DFrequency type AngularVelocity = Quantity DAngularVelocity type DAngularAcceleration = 'Dim 'Zero 'Zero 'Neg2 'Zero 'Zero 'Zero 'Zero type AngularAcceleration = Quantity DAngularAcceleration type DDynamicViscosity = 'Dim 'Neg1 'Pos1 'Neg1 'Zero 'Zero 'Zero 'Zero type DynamicViscosity = Quantity DDynamicViscosity type DMomentOfForce = DEnergy type MomentOfForce = Quantity DMomentOfForce type DSurfaceTension = 'Dim 'Zero 'Pos1 'Neg2 'Zero 'Zero 'Zero 'Zero type SurfaceTension = Quantity DSurfaceTension type DHeatFluxDensity = 'Dim 'Zero 'Pos1 'Neg3 'Zero 'Zero 'Zero 'Zero type DIrradiance = DHeatFluxDensity type HeatFluxDensity = Quantity DHeatFluxDensity type Irradiance = Quantity DIrradiance type DRadiantIntensity = DPower type RadiantIntensity = Quantity DRadiantIntensity type DRadiance = DIrradiance type Radiance = Quantity DRadiance type DHeatCapacity = 'Dim 'Pos2 'Pos1 'Neg2 'Zero 'Neg1 'Zero 'Zero type DEntropy = DHeatCapacity type HeatCapacity = Quantity DHeatCapacity type Entropy = Quantity DEntropy type DSpecificHeatCapacity = 'Dim 'Pos2 'Zero 'Neg2 'Zero 'Neg1 'Zero 'Zero type DSpecificEntropy = DSpecificHeatCapacity type SpecificHeatCapacity = Quantity DSpecificHeatCapacity type SpecificEntropy = Quantity DSpecificEntropy {- Specific energy was already defined in table 3. -} type DThermalConductivity = 'Dim 'Pos1 'Pos1 'Neg3 'Zero 'Neg1 'Zero 'Zero type ThermalConductivity = Quantity DThermalConductivity type DEnergyDensity = DPressure type EnergyDensity = Quantity DEnergyDensity type DElectricFieldStrength = 'Dim 'Pos1 'Pos1 'Neg3 'Neg1 'Zero 'Zero 'Zero type ElectricFieldStrength = Quantity DElectricFieldStrength type DElectricChargeDensity = 'Dim 'Neg3 'Zero 'Pos1 'Pos1 'Zero 'Zero 'Zero type ElectricChargeDensity = Quantity DElectricChargeDensity type DElectricFluxDensity = 'Dim 'Neg2 'Zero 'Pos1 'Pos1 'Zero 'Zero 'Zero type ElectricFluxDensity = Quantity DElectricFluxDensity type DPermittivity = 'Dim 'Neg3 'Neg1 'Pos4 'Pos2 'Zero 'Zero 'Zero type Permittivity = Quantity DPermittivity type DPermeability = 'Dim 'Pos1 'Pos1 'Neg2 'Neg2 'Zero 'Zero 'Zero type Permeability = Quantity DPermeability type DMolarEnergy = 'Dim 'Pos2 'Pos1 'Neg2 'Zero 'Zero 'Neg1 'Zero type MolarEnergy = Quantity DMolarEnergy type DMolarEntropy = 'Dim 'Pos2 'Pos1 'Neg2 'Zero 'Neg1 'Neg1 'Zero type DMolarHeatCapacity = DMolarEntropy type MolarEntropy = Quantity DMolarEntropy type MolarHeatCapacity = Quantity DMolarHeatCapacity type DExposure = 'Dim 'Zero 'Neg1 'Pos1 'Pos1 'Zero 'Zero 'Zero type Exposure = Quantity DExposure -- Exposure to x and gamma rays. type DAbsorbedDoseRate = 'Dim 'Pos2 'Zero 'Neg3 'Zero 'Zero 'Zero 'Zero type AbsorbedDoseRate = Quantity DAbsorbedDoseRate {- $not-nist-guide Here we define additional quantities on an as-needed basis. We also provide some synonyms that we anticipate will be useful. -} type DImpulse = 'Dim 'Pos1 'Pos1 'Neg1 'Zero 'Zero 'Zero 'Zero type Impulse = Quantity DImpulse type DMomentum = DImpulse type Momentum = Quantity DMomentum type DMassFlow = 'Dim 'Zero 'Pos1 'Neg1 'Zero 'Zero 'Zero 'Zero type MassFlow = Quantity DMassFlow type DVolumeFlow = 'Dim 'Pos3 'Zero 'Neg1 'Zero 'Zero 'Zero 'Zero type VolumeFlow = Quantity DVolumeFlow type DGravitationalParameter = 'Dim 'Pos3 'Zero 'Neg2 'Zero 'Zero 'Zero 'Zero type GravitationalParameter = Quantity DGravitationalParameter type DKinematicViscosity = 'Dim 'Pos2 'Zero 'Neg1 'Zero 'Zero 'Zero 'Zero type KinematicViscosity = Quantity DKinematicViscosity type DFirstMassMoment = 'Dim 'Pos1 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero type FirstMassMoment = Quantity DFirstMassMoment type DMomentOfInertia = 'Dim 'Pos2 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero type MomentOfInertia = Quantity DMomentOfInertia type DAngularMomentum = 'Dim 'Pos2 'Pos1 'Neg1 'Zero 'Zero 'Zero 'Zero type AngularMomentum = Quantity DAngularMomentum {- The reciprocal of thermal conductivity. -} type DThermalResistivity = 'Dim 'Neg1 'Neg1 'Pos3 'Zero 'Pos1 'Zero 'Zero type ThermalResistivity = Quantity DThermalResistivity {- Thermal conductance and resistance quantities after http://en.wikipedia.org/wiki/Thermal_conductivity#Definitions. -} type DThermalConductance = 'Dim 'Pos2 'Pos1 'Neg3 'Zero 'Neg1 'Zero 'Zero type ThermalConductance = Quantity DThermalConductance type DThermalResistance = 'Dim 'Neg2 'Neg1 'Pos3 'Zero 'Pos1 'Zero 'Zero type ThermalResistance = Quantity DThermalResistance type DHeatTransferCoefficient = 'Dim 'Zero 'Pos1 'Neg3 'Zero 'Neg1 'Zero 'Zero type HeatTransferCoefficient = Quantity DHeatTransferCoefficient type DThermalAdmittance = DHeatTransferCoefficient type ThermalAdmittance = HeatTransferCoefficient type DThermalInsulance = 'Dim 'Zero 'Neg1 'Pos3 'Zero 'Pos1 'Zero 'Zero type ThermalInsulance = Quantity DThermalInsulance type DJerk = 'Dim 'Pos1 'Zero 'Neg3 'Zero 'Zero 'Zero 'Zero type Jerk = Quantity DJerk type Angle = PlaneAngle -- Abbreviation type DAngle = DPlaneAngle -- Abbreviation type Thrust = Force type DThrust = DForce type Torque = MomentOfForce type DTorque = DMomentOfForce type EnergyPerUnitMass = SpecificEnergy type DEnergyPerUnitMass = DSpecificEnergy {- $powers-of-length-units It is permissible to express powers of length units by prefixing 'square' and 'cubic' (see section 9.6 "Spelling unit names raised to powers" of <#note1 [1]>). These definitions may seem slightly out of place but these is no obvious place where they should be. Here they are at least close to the definitions of 'DLength' and 'DVolume'. -} -- | Constructs a unit of area from a unit of length, taking the area of a square whose sides are that length. square :: (Fractional a, Typeable m) => Unit m DLength a -> Unit 'NonMetric DArea a square x = x ^ pos2 -- | Constructs a unit of volume from a unit of length, taking the volume of a cube whose sides are that length. cubic :: (Fractional a, Typeable m) => Unit m DLength a -> Unit 'NonMetric DVolume a cubic x = x ^ pos3 dimensional-1.0.1.3/src/Numeric/Units/Dimensional/SIUnits.hs0000644000000000000000000002717112766531445022016 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE NumDecimals #-} {-# LANGUAGE RankNTypes #-} {- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only = Summary This module defines the SI prefixes, the SI base units and the SI derived units. It also defines the units outside of the SI that are accepted for use with the SI. Any chapters, sections or tables referenced are from <#note1 [1]> unless otherwise specified. = References 1. #note1# http://physics.nist.gov/Pubs/SP811/ 2. #note2# http://en.wikipedia.org/wiki/Minute_of_arc 3. #note3# http://en.wikipedia.org/wiki/Astronomical_unit -} module Numeric.Units.Dimensional.SIUnits ( -- * SI Base Units -- $base-units metre, meter, gram, second, ampere, kelvin, mole, candela, -- * SI Derived Units -- $derived-units radian, steradian, hertz, newton, pascal, joule, watt, coulomb, volt, farad, ohm, siemens, weber, tesla, henry, lumen, lux, -- ** Celsius Temperature -- $celsius degreeCelsius, fromDegreeCelsiusAbsolute, toDegreeCelsiusAbsolute, -- ** Units Admitted for Reasons of Safeguarding Human Health -- $health becquerel, gray, sievert, katal, -- * Units Accepted for Use with the SI -- $accepted-units minute, hour, day, hectare, litre, liter, tonne, metricTon, -- ** Units of Plane Angle -- $arc-units degree, arcminute, arcsecond, -- $arc-units-alternate degreeOfArc, minuteOfArc, secondOfArc, -- ** Units Formerly Defined By Experiment -- $values-obtained-experimentally astronomicalUnit, -- * SI Prefixes -- $multiples deka, deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta, -- $submultiples deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto ) where import Numeric.Units.Dimensional import Numeric.Units.Dimensional.Quantities import Numeric.Units.Dimensional.UnitNames (PrefixName, applyPrefix, nMeter, nGram, nSecond, nAmpere, nKelvin, nMole, nCandela) import qualified Numeric.Units.Dimensional.UnitNames as N import Numeric.Units.Dimensional.UnitNames.Internal (ucum, ucumMetric) import Numeric.NumType.DK.Integers ( pos3 ) import Prelude ( ($), Num, Fractional, Floating, Integer, Rational, recip) import qualified Prelude {- $multiples Prefixes are used to form decimal multiples and submultiples of SI Units as described in section 4.4. We will define the SI prefixes in terms of the 'prefix' function which applies a scale factor to a unit. By defining SI prefixes as functions applied to a 'Unit' we satisfy section 6.2.6 "Unacceptability of stand-alone prefixes". We define all SI prefixes from Table 5. Multiples first. -} applyMultiple :: (Num a) => PrefixName -> Integer -> Unit 'Metric d a -> Unit 'NonMetric d a applyMultiple p x u = mkUnitZ (applyPrefix p (name u)) x u deka, deca, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta :: Num a => Unit 'Metric d a -> Unit 'NonMetric d a deka = applyMultiple N.deka 10 -- International English. deca = deka -- American English. hecto = applyMultiple N.hecto 100 kilo = applyMultiple N.kilo 1e3 mega = applyMultiple N.mega 1e6 giga = applyMultiple N.giga 1e9 tera = applyMultiple N.tera 1e12 peta = applyMultiple N.peta 1e15 exa = applyMultiple N.exa 1e18 zetta = applyMultiple N.zetta 1e21 yotta = applyMultiple N.yotta 1e24 {- $submultiples Then the submultiples. -} applySubmultiple :: (Fractional a) => PrefixName -> Rational -> Unit 'Metric d a -> Unit 'NonMetric d a applySubmultiple p x u = mkUnitQ (applyPrefix p (name u)) x u deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto :: Fractional a => Unit 'Metric d a -> Unit 'NonMetric d a deci = applySubmultiple N.deci 0.1 centi = applySubmultiple N.centi 0.01 milli = applySubmultiple N.milli 1e-3 micro = applySubmultiple N.micro 1e-6 nano = applySubmultiple N.nano 1e-9 pico = applySubmultiple N.pico 1e-12 femto = applySubmultiple N.femto 1e-15 atto = applySubmultiple N.atto 1e-18 zepto = applySubmultiple N.zepto 1e-21 yocto = applySubmultiple N.yocto 1e-24 {- $base-units These are the base units from section 4.1. To avoid a myriad of one-letter functions that would doubtlessly cause clashes and frustration in users' code we spell out all unit names in full, as we did for prefixes. We also elect to spell the unit names in singular form, as allowed by section 9.7 "Other spelling conventions". We define the SI base units in the order of table 1. -} metre, meter :: Num a => Unit 'Metric DLength a metre = mkUnitZ nMeter 1 siUnit -- International English. meter = metre -- American English. {- For mass the SI base unit is kilogram. For sensible prefixes we define gram here (see section 6.2.7 "Prefixes and the kilogram"). The drawback is that we are forced to use 'Fractional'. -} gram :: Fractional a => Unit 'Metric DMass a gram = mkUnitQ nGram 1e-3 siUnit second :: Num a => Unit 'Metric DTime a second = mkUnitZ nSecond 1 siUnit ampere :: Num a => Unit 'Metric DElectricCurrent a ampere = mkUnitZ nAmpere 1 siUnit kelvin :: Num a => Unit 'Metric DThermodynamicTemperature a kelvin = mkUnitZ nKelvin 1 siUnit mole :: Num a => Unit 'Metric DAmountOfSubstance a mole = mkUnitZ nMole 1 siUnit candela :: Num a => Unit 'Metric DLuminousIntensity a candela = mkUnitZ nCandela 1 siUnit {- $derived-units From Table 3, SI derived units with special names and symbols, including the radian and steradian. -} radian :: Num a => Unit 'Metric DPlaneAngle a radian = mkUnitZ (ucumMetric "rad" "rad" "radian") 1 siUnit -- meter * meter ^ neg1 steradian :: Num a => Unit 'Metric DSolidAngle a steradian = mkUnitZ (ucumMetric "sr" "sr" "steradian") 1 siUnit -- meter ^ pos2 * meter ^ neg2 hertz :: Num a => Unit 'Metric DFrequency a hertz = mkUnitZ (ucumMetric "Hz" "Hz" "Hertz") 1 $ siUnit newton :: Num a => Unit 'Metric DForce a newton = mkUnitZ (ucumMetric "N" "N" "Newton") 1 $ siUnit pascal :: Num a => Unit 'Metric DPressure a pascal = mkUnitZ (ucumMetric "Pa" "Pa" "Pascal") 1 $ siUnit joule :: Num a => Unit 'Metric DEnergy a joule = mkUnitZ (ucumMetric "J" "J" "Joule") 1 $ siUnit watt :: Num a => Unit 'Metric DPower a watt = mkUnitZ (ucumMetric "W" "W" "Watt") 1 $ siUnit coulomb :: Num a => Unit 'Metric DElectricCharge a coulomb = mkUnitZ (ucumMetric "C" "C" "Coulomb") 1 $ siUnit volt :: Num a => Unit 'Metric DElectricPotential a volt = mkUnitZ (ucumMetric "V" "V" "Volt") 1 $ siUnit farad :: Num a => Unit 'Metric DCapacitance a farad = mkUnitZ (ucumMetric "F" "F" "Farad") 1 $ siUnit ohm :: Num a => Unit 'Metric DElectricResistance a ohm = mkUnitZ (ucumMetric "Ohm" "Ω" "Ohm") 1 $ siUnit siemens :: Num a => Unit 'Metric DElectricConductance a siemens = mkUnitZ (ucumMetric "S" "S" "Siemens") 1 $ siUnit weber :: Num a => Unit 'Metric DMagneticFlux a weber = mkUnitZ (ucumMetric "Wb" "Wb" "Weber") 1 $ siUnit tesla :: Num a => Unit 'Metric DMagneticFluxDensity a tesla = mkUnitZ (ucumMetric "T" "T" "Tesla") 1 $ siUnit henry :: Num a => Unit 'Metric DInductance a henry = mkUnitZ (ucumMetric "H" "H" "Henry") 1 $ siUnit {- We defer the definition of Celcius temperature to another section (would appear here if we stricly followed table 3). -} lumen :: Num a => Unit 'Metric DLuminousFlux a lumen = mkUnitZ (ucumMetric "lm" "lm" "lumen") 1 $ siUnit lux :: Num a => Unit 'Metric DIlluminance a lux = mkUnitZ (ucumMetric "lx" "lx" "lux") 1 $ siUnit {- $celsius A problematic area is units which increase proportionally to the base SI units but cross zero at a different point. An example would be degrees Celsius (see section 4.2.1.1). The author feels that it is appropriate to define a unit for use with relative quantities (taking only into account the proportionality) and complement the unit with functions for converting absolute values. The function 'fromDegreeCelsiusAbsolute' should be used in lieu of "*~ degreeCelsius" when working with absolute temperatures. Similarily, 'toDegreeCelsiusAbsolute' should be used in lieu of "/~ degreeCelsius" when working with absolute temperatures. -} degreeCelsius :: Num a => Unit 'Metric DCelsiusTemperature a degreeCelsius = kelvin fromDegreeCelsiusAbsolute :: Floating a => a -> ThermodynamicTemperature a fromDegreeCelsiusAbsolute x = x *~ degreeCelsius + 273.15 *~ degreeCelsius toDegreeCelsiusAbsolute :: Floating a => ThermodynamicTemperature a -> a toDegreeCelsiusAbsolute x = (x - 273.15 *~ degreeCelsius) /~ degreeCelsius {- $health The last units from Table 3 are SI derived units with special names and symbols admitted for reasons of safeguarding human health. -} becquerel :: Num a => Unit 'Metric DActivity a becquerel = mkUnitZ (ucumMetric "Bq" "Bq" "Becquerel") 1 $ siUnit gray :: Num a => Unit 'Metric DAbsorbedDose a gray = mkUnitZ (ucumMetric "Gy" "Gy" "Gray") 1 $ siUnit sievert :: Num a => Unit 'Metric DDoseEquivalent a sievert = mkUnitZ (ucumMetric "Sv" "Sv" "Sievert") 1 $ siUnit katal :: Num a => Unit 'Metric DCatalyticActivity a katal = mkUnitZ (ucumMetric "kat" "kat" "katal") 1 $ siUnit {- $accepted-units There are several units that are not strictly part of the SI but are either permanently or temporarily accepted for use with the SI. We define the permanently accepted ones in this module. From Table 6, Units accepted for use with the SI. We start with time which we grant exclusive rights to 'minute' and 'second'. -} minute, hour, day :: Num a => Unit 'NonMetric DTime a minute = mkUnitZ (ucum "min" "min" "minute") 60 $ second hour = mkUnitZ (ucum "h" "h" "hour") 60 $ minute day = mkUnitZ (ucum "d" "d" "day") 24 $ hour -- Mean solar day. {- $arc-units Since 'minute' and 'second' are already in use for time we use 'arcminute' and 'arcsecond' <#note2 [2]> for plane angle instead. -} degree, arcminute, arcsecond :: Floating a => Unit 'NonMetric DPlaneAngle a degree = mkUnitR (ucum "deg" "°" "degree") (Prelude.pi Prelude./ 180) $ radian arcminute = mkUnitR (ucum "'" "'" "arcminute") (recip 60) $ degreeOfArc arcsecond = mkUnitR (ucum "''" "''" "arcsecond") (recip 60) $ minuteOfArc {- $arc-units-alternate Alternate (longer) forms of the above. In particular 'degreeOfArc' can be used if there is a percieved need to disambiguate from e.g. temperature. -} degreeOfArc, minuteOfArc, secondOfArc :: Floating a => Unit 'NonMetric DPlaneAngle a degreeOfArc = degree secondOfArc = arcsecond minuteOfArc = arcminute hectare :: Fractional a => Unit 'NonMetric DArea a hectare = square (hecto meter) litre, liter :: Fractional a => Unit 'Metric DVolume a litre = mkUnitQ (ucumMetric "L" "L" "litre") 1 $ deci meter ^ pos3 -- International English. liter = litre -- American English. tonne, metricTon :: Num a => Unit 'Metric DMass a tonne = mkUnitZ (ucumMetric "t" "t" "tonne") 1000 $ siUnit -- Name in original SI text. metricTon = tonne -- American name. {- $values-obtained-experimentally We decline to provide here those units - listed in Table 7 - which, while accepted for use with the SI, have values which are determined experimentally. For versioning purposes, those units can be found in "Numeric.Units.Dimensional.NonSI". However, in 2012 the IAU redefined the astronomical unit as a conventional unit of length directly tied to the meter, with a length of exactly 149,597,870,700 m and the official abbreviation of au <#note3 [3]>. We therefore include it here. -} astronomicalUnit :: Num a => Unit 'NonMetric DLength a astronomicalUnit = mkUnitZ (ucum "AU" "AU" "astronomical unit") 149597870700 $ meter dimensional-1.0.1.3/src/Numeric/Units/Dimensional/NonSI.hs0000644000000000000000000003035712766531445021446 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE NumDecimals #-} {- | Copyright : Copyright (C) 2006-2015 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# http://physics.nist.gov/Pubs/SP811/ 2. #note2# http://www.iau.org/science/publications/proceedings_rules/units/ 3. #note3# http://en.m.wikipedia.org/wiki/Pressure 4. #note4# http://en.m.wikipedia.org/wiki/Torr -} module Numeric.Units.Dimensional.NonSI ( -- * Units Defined By Experiment -- $values-obtained-experimentally electronVolt, unifiedAtomicMassUnit, dalton, -- * Standard Gravity -- $standard-gravity gee, -- * Inch-pound Units -- $inch-pound-units inch, foot, mil, poundMass, ounce, poundForce, slug, psi, yard, mile, nauticalMile, knot, revolution, solid, teaspoon, acre, -- * Years -- $year year, century, -- * 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 ) where import Data.ExactPi import Numeric.Units.Dimensional.Prelude import Numeric.Units.Dimensional.UnitNames.Internal (ucumMetric, ucum, dimensionalAtom) import qualified Prelude {- $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 = mkUnitR (ucumMetric "eV" "eV" "electron volt") (Approximate 1.60217733e-19) $ joule unifiedAtomicMassUnit :: Floating a => Unit 'Metric DMass a unifiedAtomicMassUnit = mkUnitR (ucumMetric "u" "u" "atomic mass unit") (Approximate 1.6605402e-27) $ kilo gram dalton :: Floating a => Unit 'Metric DMass a dalton = mkUnitR (ucumMetric "eV" "Da" "Dalton") 1 $ unifiedAtomicMassUnit {- $standard-gravity In order to relate e.g. pounds mass to pounds force we define the unit 'gee' equal to the standard gravity g_0: the nominal acceleration of a body in free fall in a vacuum near the surface of the earth (note that local values of acceleration due to gravity will differ from the standard gravity). I.e. g_0 = 1 gee. -} gee :: Fractional a => Unit 'Metric DAcceleration a gee = mkUnitQ (ucumMetric "[g]" "g" "gee") 9.80665 $ meter / second ^ pos2 {- $inch-pound-units Some US customary (that is, inch-pound) units. -} inch, foot, mil :: Fractional a => Unit 'NonMetric DLength a inch = mkUnitQ (ucum "[in_i]" "in" "inch") 2.54 $ centi meter foot = mkUnitQ (ucum "[ft_i]" "ft" "foot") 12 $ inch -- 0.3048 m mil = mkUnitQ (ucum "[mil_i]" "mil" "mil") 0.001 $ inch poundMass, ounce :: Fractional a => Unit 'NonMetric DMass a poundMass = mkUnitQ (ucum "[lb_av]" "lb" "pound") 0.45359237 $ kilo gram ounce = mkUnitQ (ucum "[oz_av]" "oz" "ounce") (1 Prelude./ 16) $ poundMass poundForce :: Fractional a => Unit 'NonMetric DForce a poundForce = mkUnitQ (ucum "[lbf_av]" "lbf" "pound force") 1 $ poundMass * gee -- 4.4482 N {- The slug is an alternative unit of mass defined in terms of the pound-force. -} slug :: Fractional a => Unit 'NonMetric DMass a slug = poundForce * (second^pos2) / foot {- Pounds of force per square inch. -} psi :: Fractional a => Unit 'NonMetric DPressure a psi = mkUnitQ (ucum "[psi]" "psi" "pound per square inch") 1 $ poundForce / inch ^ pos2 {- = Various other (non inch-pound) units = -} yard, mile :: (Fractional a) => Unit 'NonMetric DLength a yard = mkUnitQ (ucum "[yd_i]" "yd" "yard") 3 $ foot mile = mkUnitQ (ucum "[mi_i]" "mi" "mile") 5280 $ foot nauticalMile :: (Num a) => Unit 'NonMetric DLength a nauticalMile = mkUnitZ (ucum "[nmi_i]" "NM" "nautical mile") 1852 $ meter knot :: (Fractional a) => Unit 'NonMetric DVelocity a knot = mkUnitQ (ucum "[kt_i]" "kt" "knot") 1 $ nauticalMile / hour revolution :: (Floating a) => Unit 'NonMetric DOne a revolution = mkUnitR (dimensionalAtom "rev" "rev" "revolution") (2 Prelude.* Prelude.pi) $ radian solid :: (Floating a) => Unit 'NonMetric DOne a solid = mkUnitR (dimensionalAtom "solid" "solid" "solid") (4 Prelude.* Prelude.pi) $ steradian teaspoon :: (Fractional a) => Unit 'NonMetric DVolume a teaspoon = mkUnitQ (ucum "[tsp_m]" "tsp" "teaspoon") 5 $ milli liter acre :: (Fractional a) => Unit 'NonMetric DArea a acre = mkUnitQ (ucum "[acr_us]" "ac" "acre") 43560 $ square foot {- $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 (31.5576 Ms) unless otherwise specified. We define the year in terms of seconds in order to avoid a 'Fractional' constraint, and also provide a Julian century. -} year, century :: Num a => Unit 'NonMetric DTime a year = mkUnitZ (ucum "a_j" "a" "mean Julian year") 31557600 $ second century = mkUnitZ (dimensionalAtom "c_j" "cen" "mean Julian century") 100 $ 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. bar :: (Num a) => Unit 'Metric DPressure a bar = mkUnitZ (ucumMetric "bar" "bar" "bar") 1e5 $ 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. atmosphere :: (Num a) => Unit 'NonMetric DPressure a atmosphere = mkUnitZ (ucum "atm" "atm" "standard atmosphere") 101325 $ 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. technicalAtmosphere :: (Fractional a) => Unit 'NonMetric DPressure a technicalAtmosphere = mkUnitQ (ucum "att" "at" "technical atmosphere") 1 $ kilo gram * gee * centi meter ^ 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'. mmHg :: (Floating a) => Unit 'NonMetric DPressure a mmHg = milli mHg mHg :: (Floating a) => Unit 'Metric DPressure a mHg = mkUnitR (ucumMetric "m[Hg]" "m Hg" "meter of mercury") (Approximate 133.3220) $ kilo 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'. inHg :: (Floating a) => Unit 'NonMetric DPressure a inHg = 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'. inHg_UCUM :: (Floating a) => Unit 'NonMetric DPressure a inHg_UCUM = mkUnitR (ucum "[in_i'Hg]" "in Hg" "inch of mercury") 1 $ mHg * inch / 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'. inHg_NIST :: (Floating a) => Unit 'NonMetric DPressure a inHg_NIST = mkUnitR (dimensionalAtom "[in_i'Hg_NIST]" "in Hg" "inch of mercury") 3.386389 $ pascal -- | One torr (symbol: Torr) is defined as 1/760 atm, which is approximately equal to 1 'mmHg'. torr :: (Fractional a) => Unit 'NonMetric DPressure a torr = mkUnitQ (dimensionalAtom "Torr" "Torr" "Torr") (1 Prelude./ 760) $ atmosphere {- Radiation -} rad :: (Fractional a) => Unit 'Metric DAbsorbedDose a rad = mkUnitQ (ucumMetric "RAD" "RAD" "RAD") 1 $ centi gray {- Kinematic Viscosity -} stokes :: (Fractional a) => Unit 'Metric DKinematicViscosity a stokes = mkUnitQ (ucumMetric "St" "St" "Stokes") 1 $ centi meter ^ pos2 / second {- $temperature These units of temperature are relative. For absolute temperatures, see 'Numeric.Units.Dimensional.SIUnits.fromDegreeCelsiusAbsolute'. -} degreeFahrenheit :: (Fractional a) => Unit 'NonMetric DThermodynamicTemperature a degreeFahrenheit = mkUnitQ (ucum "[degF]" "°F" "degree Fahrenheit") (5 Prelude./ 9) $ degreeCelsius degreeRankine :: (Fractional a) => Unit 'NonMetric DThermodynamicTemperature a degreeRankine = mkUnitQ (ucum "[degR]" "°R" "degree Rankine") 1 $ degreeFahrenheit {- $imperial-volumes Per http://en.wikipedia.org/wiki/Imperial_units and http://en.wikipedia.org/wiki/Cup_(unit)#Imperial_cup. -} imperialGallon, imperialQuart, imperialPint, imperialCup, imperialGill, imperialFluidOunce :: (Fractional a) => Unit 'NonMetric DVolume a imperialGallon = mkUnitQ (ucum "[gal_br]" "gal" "gallon") 4.54609 $ liter imperialQuart = mkUnitQ (ucum "[qt_br]" "qt" "quart") (1 Prelude./ 4) $ imperialGallon imperialPint = mkUnitQ (ucum "[pt_br]" "pt" "pint") (1 Prelude./ 8) $ imperialGallon imperialCup = mkUnitQ (dimensionalAtom "[cup_br]" "cup" "cup") 0.5 $ imperialPint imperialGill = mkUnitQ (ucum "[gil_br]" "gill" "gill") (1 Prelude./ 4) $ imperialPint imperialFluidOunce = mkUnitQ (ucum "[foz_br]" "fl oz" "fluid ounce") (1 Prelude./ 20) $ imperialPint {- $us-customary-volumes Per http://www.nist.gov/pml/wmd/pubs/upload/2012-hb44-final.pdf page 452 and http://en.wikipedia.org/wiki/United_States_customary_units#Fluid_volume Note that there exist rarely-used "dry" variants of units with overlapping names. -} usGallon, usQuart, usPint, usCup, usGill, usFluidOunce :: (Fractional a) => Unit 'NonMetric DVolume a usGallon = mkUnitQ (ucum "[gal_us]" "gal" "gallon") 231 $ (cubic inch) usQuart = mkUnitQ (ucum "[qt_us]" "qt" "quart") (1 Prelude./ 4) $ usGallon usPint = mkUnitQ (ucum "[pt_us]" "pt" "pint") (1 Prelude./ 8) $ usGallon usCup = mkUnitQ (ucum "[cup_us]" "cup" "cup") (1 Prelude./ 2) $ usPint usGill = mkUnitQ (ucum "[gil_us]" "gill" "gill") (1 Prelude./ 4) $ usPint usFluidOunce = mkUnitQ (ucum "[foz_us]" "fl oz" "fluid ounce") (1 Prelude./ 16) $ usPint -- sic, does not match factor used in imperial system dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Dimensions.hs0000644000000000000000000000203212766531445022555 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only Provides both term-level and type-level representations for physical dimensions in a single import for convenience. Presuming that users intend to work primarily with type level dimensions, this module hides arithmetic operators over term level dimensions and aliases for the base term-level dimensions to avoid namespace pollution. These features are available directly from "Numeric.Units.Dimensional.Dimensions.TermLevel" if desired. -} module Numeric.Units.Dimensional.Dimensions ( module Numeric.Units.Dimensional.Dimensions.TermLevel, module Numeric.Units.Dimensional.Dimensions.TypeLevel ) where import Numeric.Units.Dimensional.Dimensions.TermLevel hiding ((*), (/), (^), recip, dLength, dMass, dTime, dElectricCurrent, dThermodynamicTemperature, dAmountOfSubstance, dLuminousIntensity) import Numeric.Units.Dimensional.Dimensions.TypeLevel dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Dimensions/TermLevel.hs0000644000000000000000000000646212766531445024467 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home, show-extensions #-} {- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only This module defines physical dimensions expressed in terms of the SI base dimensions, including arithmetic. -} module Numeric.Units.Dimensional.Dimensions.TermLevel ( -- * Type Dimension'(..), -- * Access to Dimension of Dimensional Values HasDimension(..), -- * Dimension Arithmetic (*), (/), (^), recip, -- * Synonyms for Base Dimensions dOne, dLength, dMass, dTime, dElectricCurrent, dThermodynamicTemperature, dAmountOfSubstance, dLuminousIntensity, -- * Deconstruction asList ) where import Data.Monoid (Monoid(..)) import Prelude (id, (+), (-), Int, Show, Eq, Ord) import qualified Prelude as P -- | A physical dimension, encoded as 7 integers, representing a factorization of the dimension into the -- 7 SI base dimensions. By convention they are stored in the same order as -- in the 'Numeric.Units.Dimensional.Dimensions.TypeLevel.Dimension' data kind. data Dimension' = Dim' !Int !Int !Int !Int !Int !Int !Int deriving (Show, Eq, Ord) -- | The monoid of dimensions under multiplication. instance Monoid Dimension' where mempty = dOne mappend = (*) -- | Dimensional values inhabit this class, which allows access to a term-level representation of their dimension. class HasDimension a where -- | Obtains a term-level representation of a value's dimension. dimension :: a -> Dimension' instance HasDimension Dimension' where dimension = id -- | The dimension of dimensionless values. dOne :: Dimension' dOne = Dim' 0 0 0 0 0 0 0 dLength, dMass, dTime, dElectricCurrent, dThermodynamicTemperature, dAmountOfSubstance, dLuminousIntensity :: Dimension' dLength = Dim' 1 0 0 0 0 0 0 dMass = Dim' 0 1 0 0 0 0 0 dTime = Dim' 0 0 1 0 0 0 0 dElectricCurrent = Dim' 0 0 0 1 0 0 0 dThermodynamicTemperature = Dim' 0 0 0 0 1 0 0 dAmountOfSubstance = Dim' 0 0 0 0 0 1 0 dLuminousIntensity = Dim' 0 0 0 0 0 0 1 {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixr 8 ^ infixl 7 *, / -- | Forms the product of two dimensions. (*) :: Dimension' -> Dimension' -> Dimension' (Dim' l m t i th n j) * (Dim' l' m' t' i' th' n' j') = Dim' (l + l') (m + m') (t + t') (i + i') (th + th') (n + n') (j + j') -- | Forms the quotient of two dimensions. (/) :: Dimension' -> Dimension' -> Dimension' (Dim' l m t i th n j) / (Dim' l' m' t' i' th' n' j') = Dim' (l - l') (m - m') (t - t') (i - i') (th - th') (n - n') (j - j') -- | Raises a dimension to an integer power. (^) :: Dimension' -> Int -> Dimension' (Dim' l m t i th n j) ^ x = Dim' (x P.* l) (x P.* m) (x P.* t) (x P.* i) (x P.* th) (x P.* n) (x P.* j) -- | Forms the reciprocal of a dimension. recip :: Dimension' -> Dimension' recip = (dOne /) -- | Converts a dimension to a list of 7 integers, representing the exponent associated with each -- of the 7 SI base dimensions in the standard order. asList :: Dimension' -> [Int] asList (Dim' l m t i th n j) = [l, m, t, i, th, n, j] dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Dimensions/TypeLevel.hs0000644000000000000000000001264712766531445024503 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home, show-extensions #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only This module defines type-level physical dimensions expressed in terms of the SI base dimensions using 'Numeric.NumType.DK.NumType' for type-level integers. Type-level arithmetic, synonyms for the base dimensions, and conversion to the term-level are included. -} module Numeric.Units.Dimensional.Dimensions.TypeLevel ( -- * Kind of Type-Level Dimensions type Dimension(..), -- * Dimension Arithmetic type (*), type (/), type (^), type Recip, type Root, -- * Synonyms for Base Dimensions DOne, DLength, DMass, DTime, DElectricCurrent, DThermodynamicTemperature, DAmountOfSubstance, DLuminousIntensity, -- * Conversion to Term Level type KnownDimension ) where import Data.Proxy import Numeric.NumType.DK.Integers ( TypeInt (Zero, Pos1), type (+), type (-) , KnownTypeInt, toNum ) import qualified Numeric.NumType.DK.Integers as N import Numeric.Units.Dimensional.Dimensions.TermLevel -- | Represents a physical dimension in the basis of the 7 SI base dimensions, -- where the respective dimensions are represented by type variables -- using the following convention. -- -- * l: Length -- * m: Mass -- * t: Time -- * i: Electric current -- * th: Thermodynamic temperature -- * n: Amount of substance -- * j: Luminous intensity -- -- For the equivalent term-level representation, see 'Dimension'' data Dimension = Dim TypeInt TypeInt TypeInt TypeInt TypeInt TypeInt TypeInt -- | The type-level dimensions of dimensionless values. type DOne = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type DLength = 'Dim 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero type DMass = 'Dim 'Zero 'Pos1 'Zero 'Zero 'Zero 'Zero 'Zero type DTime = 'Dim 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero 'Zero type DElectricCurrent = 'Dim 'Zero 'Zero 'Zero 'Pos1 'Zero 'Zero 'Zero type DThermodynamicTemperature = 'Dim 'Zero 'Zero 'Zero 'Zero 'Pos1 'Zero 'Zero type DAmountOfSubstance = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 'Zero type DLuminousIntensity = 'Dim 'Zero 'Zero 'Zero 'Zero 'Zero 'Zero 'Pos1 {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixr 8 ^ infixl 7 *, / -- | Multiplication of dimensions corresponds to adding of the base -- dimensions' exponents. type family (a::Dimension) * (b::Dimension) where DOne * d = d d * DOne = d ('Dim l m t i th n j) * ('Dim l' m' t' i' th' n' j') = 'Dim (l + l') (m + m') (t + t') (i + i') (th + th') (n + n') (j + j') -- | Division of dimensions corresponds to subtraction of the base -- dimensions' exponents. type family (a::Dimension) / (d::Dimension) where d / DOne = d d / d = DOne ('Dim l m t i th n j) / ('Dim l' m' t' i' th' n' j') = 'Dim (l - l') (m - m') (t - t') (i - i') (th - th') (n - n') (j - j') -- | The reciprocal of a dimension is defined as the result of dividing 'DOne' by it, -- or of negating each of the base dimensions' exponents. type Recip (d :: Dimension) = DOne / d -- | Powers of dimensions corresponds to multiplication of the base -- dimensions' exponents by the exponent. -- -- We limit ourselves to integer powers of Dimensionals as fractional -- powers make little physical sense. type family (d::Dimension) ^ (x::TypeInt) where DOne ^ x = DOne d ^ 'Zero = DOne d ^ 'Pos1 = d ('Dim l m t i th n j) ^ x = 'Dim (l N.* x) (m N.* x) (t N.* x) (i N.* x) (th N.* x) (n N.* x) (j N.* x) -- | Roots of dimensions corresponds to division of the base dimensions' -- exponents by the order(?) of the root. -- -- See 'sqrt', 'cbrt', and 'nroot' for the corresponding term-level operations. type family Root (d::Dimension) (x::TypeInt) where Root DOne x = DOne Root d 'Pos1 = d Root ('Dim l m t i th n j) x = 'Dim (l N./ x) (m N./ x) (t N./ x) (i N./ x) (th N./ x) (n N./ x) (j N./ x) -- | A KnownDimension is one for which we can construct a term-level representation. -- Each validly constructed type of kind 'Dimension' has a 'KnownDimension' instance. -- -- While 'KnownDimension' is a constraint synonym, the presence of @'KnownDimension' d@ in -- a context allows use of @'dimension' :: 'Proxy' d -> 'Dimension''@. type KnownDimension (d :: Dimension) = HasDimension (Proxy d) instance ( KnownTypeInt l , KnownTypeInt m , KnownTypeInt t , KnownTypeInt i , KnownTypeInt th , KnownTypeInt n , KnownTypeInt j ) => HasDimension (Proxy ('Dim l m t i th n j)) where dimension _ = Dim' (toNum (Proxy :: Proxy l)) (toNum (Proxy :: Proxy m)) (toNum (Proxy :: Proxy t)) (toNum (Proxy :: Proxy i)) (toNum (Proxy :: Proxy th)) (toNum (Proxy :: Proxy n)) (toNum (Proxy :: Proxy j)) dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Dynamic.hs0000644000000000000000000000560112766531445022036 0ustar0000000000000000{- | Copyright : Copyright (C) 2006-2014 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only? Defines types for manipulation of units and quantities without phantom types for their dimensions. -} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ScopedTypeVariables #-} module Numeric.Units.Dimensional.Dynamic ( -- * Dynamic Quantities AnyQuantity , demoteQuantity, promoteQuantity -- * Dynamic Units , AnyUnit , demoteUnit, promoteUnit ) where import Numeric.Units.Dimensional.Prelude hiding (lookup) import Numeric.Units.Dimensional.Coercion import Numeric.Units.Dimensional.UnitNames (UnitName, baseUnitName) import Data.ExactPi import Data.Proxy -- | A 'Quantity' whose 'Dimension' is only known dynamically. data AnyQuantity v = AnyQuantity Dimension' v deriving (Eq) instance (Show v) => Show (AnyQuantity v) where show (AnyQuantity d v) = (show v) ++ " " ++ (show . baseUnitName $ d) instance HasDimension (AnyQuantity v) where dimension (AnyQuantity d _) = d -- | Converts a 'Quantity' of statically known 'Dimension' into an 'AnyQuantity'. demoteQuantity :: forall d v.(KnownDimension d) => Quantity d v -> AnyQuantity v demoteQuantity (Quantity val) = AnyQuantity dim val where dim = dimension (Proxy :: Proxy d) -- | Converts an 'AnyQuantity' into a 'Quantity' of statically known 'Dimension', or 'Nothing' if the dimension does not match. promoteQuantity :: forall d v.(KnownDimension d) => AnyQuantity v -> Maybe (Quantity d v) promoteQuantity (AnyQuantity dim val) | dim == dim' = Just . Quantity $ val | otherwise = Nothing where dim' = dimension (Proxy :: Proxy d) -- | A 'Unit' whose 'Dimension' is only known dynamically. data AnyUnit = AnyUnit Dimension' (UnitName 'NonMetric) ExactPi instance Show AnyUnit where show (AnyUnit _ n e) = "1 " ++ (show n) ++ " =def= " ++ (show e) ++ " of the SI base unit" instance HasDimension AnyUnit where dimension (AnyUnit d _ _) = d -- | Converts a 'Unit' of statically known 'Dimension' into an 'AnyUnit'. demoteUnit :: forall a d v.(KnownDimension d) => Unit a d v -> AnyUnit demoteUnit u = AnyUnit dim (name $ weaken u) (exactValue u) where dim = dimension (Proxy :: Proxy d) -- | Converts an 'AnyUnit' into a 'Unit' of statically known 'Dimension', or 'Nothing' if the dimension does not match. -- -- The result is represented in 'ExactPi', conversion to other representations is possible using 'changeRepApproximate'. promoteUnit :: forall d.(KnownDimension d) => AnyUnit -> Maybe (Unit 'NonMetric d ExactPi) promoteUnit (AnyUnit dim n e) | dim == dim' = Just $ mkUnitR n e siUnit | otherwise = Nothing where dim' = dimension (Proxy :: Proxy d) dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Functor.hs0000644000000000000000000000254512766531445022076 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,0) -- OverlappingInstances was deprecated by GHC 7.10 in favor of OVERLAPPING pragmas. #else {-# LANGUAGE OverlappingInstances #-} {-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-} #endif {- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only Provides a 'Functor' instance for 'Dimensional'. Note that this instance is dubious, because it allows you to break the dimensional abstraction. See 'dmap' for more information. Note that, while this instance overlaps with that given for 'Dimensionless', it is confluent with that instance. Note that this is an orphan instance. -} module Numeric.Units.Dimensional.Functor where import Numeric.Units.Dimensional -- | A 'Functor' instance for 'Dimensional'. -- -- Note that this instance is dubious, because it allows you to break the dimensional abstraction. See 'dmap' for more information. -- -- Note that, while this instance overlaps with that given for 'Dimensionless', it is confluent with that instance. -- -- Note that this is an orphan instance. instance {-# OVERLAPPING #-} (KnownVariant v) => Functor (Dimensional v d) where fmap = dmap dimensional-1.0.1.3/src/Numeric/Units/Dimensional/UnitNames.hs0000644000000000000000000000250712766531445022357 0ustar0000000000000000{-# LANGUAGE PatternSynonyms #-} {- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only This module provides types and functions for manipulating unit names. Please note that the details of the name representation may be less stable than the other APIs provided by this package, as new features using them are still being developed. -} module Numeric.Units.Dimensional.UnitNames ( -- * Data Types UnitName, NameAtom, PrefixName, Metricality(..), -- * Construction of Unit Names atom, applyPrefix, (*), (/), (^), product, reduce, grouped, -- * Standard Names baseUnitName, -- ** Names for the Base Units nOne, nMeter, nGram, nKilogram, nSecond, nAmpere, nKelvin, nMole, nCandela, -- ** Names for the SI Metric Prefixes deka, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta, deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto, -- * Convenience Type Synonyms for Unit Name Transformations UnitNameTransformer, UnitNameTransformer2, -- * Forgetting Unwanted Phantom Types weaken, strengthen, relax ) where import Numeric.Units.Dimensional.UnitNames.Internal import Numeric.Units.Dimensional.Variants import Prelude hiding ((*), (/), (^), product) dimensional-1.0.1.3/src/Numeric/Units/Dimensional/UnitNames/InterchangeNames.hs0000644000000000000000000000271612766531445025574 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Numeric.Units.Dimensional.UnitNames.InterchangeNames ( InterchangeNameAuthority(..), InterchangeName(..), HasInterchangeName(..) ) where import Data.Data import GHC.Generics -- | Represents the authority which issued an interchange name for a unit. data InterchangeNameAuthority = UCUM -- ^ The interchange name originated with the Unified Code for Units of Measure. | DimensionalLibrary -- ^ The interchange name originated with the dimensional library. | Custom -- ^ The interchange name originated with a user of the dimensional library. deriving (Eq, Ord, Show, Data, Typeable, Generic) data InterchangeName = InterchangeName { name :: String, authority :: InterchangeNameAuthority } deriving (Eq, Ord, Data, Typeable, Generic) instance Show InterchangeName where show n = name n ++ " (Issued by " ++ show (authority n) ++ ")" -- | Determines the authority which issued the interchange name of a unit or unit name. -- For composite units, this is the least-authoritative interchange name of any constituent name. -- -- Note that the least-authoritative authority is the one sorted as greatest by the 'Ord' instance of 'InterchangeNameAuthority'. class HasInterchangeName a where interchangeName :: a -> InterchangeName instance HasInterchangeName InterchangeName where interchangeName = id dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Variants.hs0000644000000000000000000000416712766531445022247 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home, show-extensions #-} {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {- | Copyright : Copyright (C) 2006-2015 Bjorn Buckwalter License : BSD3 Maintainer : bjorn@buckwalter.se Stability : Stable Portability: GHC only Provides a type level representation of 'Variant's of dimensional values, which may be quantities or units. -} module Numeric.Units.Dimensional.Variants ( type Variant(..), Metricality(..), type (*), type Weaken ) where import Data.Data import GHC.Generics -- | Encodes whether a unit is a metric unit, that is, whether it can be combined -- with a metric prefix to form a related unit. data Metricality = Metric -- ^ Capable of receiving a metric prefix. | NonMetric -- ^ Incapable of receiving a metric prefix. deriving (Eq, Ord, Data, Typeable, Generic) {- The variety 'v' of 'Dimensional' The phantom type variable v is used to distinguish between units and quantities. It must be one of the following: -} -- | The kind of variants of dimensional values. data Variant = DQuantity -- ^ The value is a quantity. | DUnit Metricality -- ^ The value is a unit, possibly a 'Metric' unit. deriving (Eq, Ord, Data, Typeable, Generic) {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixl 7 * -- | Forms the product of two 'Variant's. -- -- The product of units is a non-metric unit. -- -- The product of quantities is a quantity. type family (v1 :: Variant) * (v2 :: Variant) :: Variant where 'DUnit m1 * 'DUnit m2 = 'DUnit 'NonMetric 'DQuantity * 'DQuantity = 'DQuantity -- | Weakens a 'Variant' by forgetting possibly uninteresting type-level information. type family Weaken (v :: Variant) :: Variant where Weaken 'DQuantity = 'DQuantity Weaken ('DUnit m) = 'DUnit 'NonMetric dimensional-1.0.1.3/src/Numeric/Units/Dimensional/Internal.hs0000644000000000000000000002346712766531445022240 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} -- for Vector instances only {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} module Numeric.Units.Dimensional.Internal ( KnownVariant(..), Dimensional(..), type Unit, type Quantity, siUnit, showIn, liftD, liftD2, liftQ, liftQ2 ) where import Control.Applicative import Control.DeepSeq import Control.Monad (liftM) import Data.Coerce (coerce) import Data.Data import Data.ExactPi import Data.Monoid (Monoid(..)) import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable(..)) import GHC.Generics import Numeric.Units.Dimensional.Dimensions import Numeric.Units.Dimensional.Variants hiding (type (*)) import qualified Numeric.Units.Dimensional.Variants as V import Numeric.Units.Dimensional.UnitNames hiding ((*), (/), (^), weaken, strengthen) import qualified Numeric.Units.Dimensional.UnitNames.Internal as Name import Numeric.Units.Dimensional.UnitNames.InterchangeNames (HasInterchangeName(..)) import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Base as U import Prelude ( Show, Eq(..), Ord, Bounded(..), Num, Fractional, Functor , String, Maybe(..) , (.), ($), (++), (+), (/) , show, otherwise, undefined, error, fmap ) -- | A unit of measurement. type Unit (m :: Metricality) = Dimensional ('DUnit m) -- | A dimensional quantity. type Quantity = Dimensional 'DQuantity -- | A physical quantity or unit. -- -- We call this data type 'Dimensional' to capture the notion that the -- units and quantities it represents have physical dimensions. -- -- The type variable 'a' is the only non-phantom type variable and -- represents the numerical value of a quantity or the scale (w.r.t. -- SI units) of a unit. For SI units the scale will always be 1. For -- non-SI units the scale is the ratio of the unit to the SI unit with -- the same physical dimension. -- -- Since 'a' is the only non-phantom type we were able to define -- 'Dimensional' as a newtype, avoiding boxing at runtime. class KnownVariant (v :: Variant) where -- | A dimensional value, either a 'Quantity' or a 'Unit', parameterized by its 'Dimension' and representation. data Dimensional v :: Dimension -> * -> * extractValue :: Dimensional v d a -> (a, Maybe ExactPi) extractName :: Dimensional v d a -> Maybe (UnitName 'NonMetric) injectValue :: (Maybe (UnitName 'NonMetric)) -> (a, Maybe ExactPi) -> Dimensional v d a -- | Maps over the underlying representation of a dimensional value. -- The caller is responsible for ensuring that the supplied function respects the dimensional abstraction. -- This means that the function must preserve numerical values, or linearly scale them while preserving the origin. dmap :: (a1 -> a2) -> Dimensional v d a1 -> Dimensional v d a2 deriving instance Typeable Dimensional instance KnownVariant 'DQuantity where newtype Dimensional 'DQuantity d a = Quantity a deriving (Eq, Ord, Data, Generic, Generic1 #if MIN_VERSION_base(4,8,0) , Typeable -- GHC 7.8 doesn't support deriving this instance #endif ) extractValue (Quantity x) = (x, Nothing) extractName _ = Nothing injectValue _ (x, _) = Quantity x dmap = coerce instance (Typeable m) => KnownVariant ('DUnit m) where data Dimensional ('DUnit m) d a = Unit !(UnitName m) !ExactPi !a deriving (Generic, Generic1 #if MIN_VERSION_base(4,8,0) , Typeable -- GHC 7.8 doesn't support deriving this instance #endif ) extractValue (Unit _ e x) = (x, Just e) extractName (Unit n _ _) = Just . Name.weaken $ n injectValue (Just n) (x, Just e) | Just n' <- relax n = Unit n' e x | otherwise = error "Shouldn't be reachable. Needed a metric name but got a non-metric one." injectValue _ _ = error "Shouldn't be reachable. Needed to name a quantity." dmap f (Unit n e x) = Unit n e (f x) -- GHC is somewhat unclear about why, but it won't derive this instance, so we give it explicitly. instance (Bounded a) => Bounded (Quantity d a) where minBound = Quantity minBound maxBound = Quantity maxBound instance HasInterchangeName (Unit m d a) where interchangeName (Unit n _ _) = interchangeName n {- Since quantities form a monoid under addition, but not under multiplication unless they are dimensionless, we will define a monoid instance that adds. -} -- | 'Quantity's of a given 'Dimension' form a 'Monoid' under addition. instance (Num a) => Monoid (Quantity d a) where mempty = Quantity 0 mappend = liftQ2 (+) {- = Dimensionless = For dimensionless quantities pretty much any operation is applicable. We provide this freedom by making 'Dimensionless' an instance of 'Functor'. -} instance Functor (Quantity DOne) where fmap = dmap instance (KnownDimension d) => HasDimension (Dimensional v d a) where dimension _ = dimension (Proxy :: Proxy d) -- | A polymorphic 'Unit' which can be used in place of the coherent -- SI base unit of any dimension. This allows polymorphic quantity -- creation and destruction without exposing the 'Dimensional' constructor. siUnit :: forall d a.(KnownDimension d, Num a) => Unit 'NonMetric d a siUnit = Unit (baseUnitName $ dimension (Proxy :: Proxy d)) 1 1 instance NFData a => NFData (Quantity d a) -- instance is derived from Generic instance instance Storable a => Storable (Quantity d a) where sizeOf _ = sizeOf (undefined::a) {-# INLINE sizeOf #-} alignment _ = alignment (undefined::a) {-# INLINE alignment #-} poke ptr = poke (castPtr ptr :: Ptr a) . coerce {-# INLINE poke #-} peek ptr = liftM Quantity (peek (castPtr ptr :: Ptr a)) {-# INLINE peek #-} {- Instances for vectors of quantities. -} newtype instance U.Vector (Quantity d a) = V_Quantity {unVQ :: U.Vector a} newtype instance U.MVector s (Quantity d a) = MV_Quantity {unMVQ :: U.MVector s a} instance U.Unbox a => U.Unbox (Quantity d a) instance (M.MVector U.MVector a) => M.MVector U.MVector (Quantity d a) where basicLength = M.basicLength . unMVQ {-# INLINE basicLength #-} basicUnsafeSlice m n = MV_Quantity . M.basicUnsafeSlice m n . unMVQ {-# INLINE basicUnsafeSlice #-} basicOverlaps u v = M.basicOverlaps (unMVQ u) (unMVQ v) {-# INLINE basicOverlaps #-} basicUnsafeNew = liftM MV_Quantity . M.basicUnsafeNew {-# INLINE basicUnsafeNew #-} basicUnsafeRead v = liftM Quantity . M.basicUnsafeRead (unMVQ v) {-# INLINE basicUnsafeRead #-} basicUnsafeWrite v i = M.basicUnsafeWrite (unMVQ v) i . coerce {-# INLINE basicUnsafeWrite #-} #if MIN_VERSION_vector(0,11,0) basicInitialize = M.basicInitialize . unMVQ {-# INLINE basicInitialize #-} #endif instance (G.Vector U.Vector a) => G.Vector U.Vector (Quantity d a) where basicUnsafeFreeze = liftM V_Quantity . G.basicUnsafeFreeze . unMVQ {-# INLINE basicUnsafeFreeze #-} basicUnsafeThaw = liftM MV_Quantity . G.basicUnsafeThaw . unVQ {-# INLINE basicUnsafeThaw #-} basicLength = G.basicLength . unVQ {-# INLINE basicLength #-} basicUnsafeSlice m n = V_Quantity . G.basicUnsafeSlice m n . unVQ {-# INLINE basicUnsafeSlice #-} basicUnsafeIndexM v = liftM Quantity . G.basicUnsafeIndexM (unVQ v) {-# INLINE basicUnsafeIndexM #-} {- We will conclude by providing a reasonable 'Show' instance for quantities. The SI unit of the quantity is inferred from its dimension. -} instance (KnownDimension d, Show a, Fractional a) => Show (Quantity d a) where show = showIn siUnit -- | Shows the value of a 'Quantity' expressed in a specified 'Unit' of the same 'Dimension'. showIn :: (KnownDimension d, Show a, Fractional a) => Unit m d a -> Quantity d a -> String showIn (Unit n _ y) (Quantity x) | Name.weaken n == nOne = show (x / y) | otherwise = (show (x / y)) ++ " " ++ (show n) instance (KnownDimension d, Show a) => Show (Unit m d a) where show (Unit n e x) = "The unit " ++ show n ++ ", with value " ++ show e ++ " (or " ++ show x ++ ")" -- Operates on a dimensional value using a unary operation on values, possibly yielding a Unit. liftD :: (KnownVariant v1, KnownVariant v2) => (ExactPi -> ExactPi) -> (a -> b) -> UnitNameTransformer -> (Dimensional v1 d1 a) -> (Dimensional v2 d2 b) liftD fe f nt x = let (x', e') = extractValue x n = extractName x n' = (liftA nt) n in injectValue n' (f x', fmap fe e') -- Operates on a dimensional value using a unary operation on values, yielding a Quantity. liftQ :: (a -> a) -> Quantity d1 a -> Quantity d2 a liftQ = coerce -- Combines two dimensional values using a binary operation on values, possibly yielding a Unit. liftD2 :: (KnownVariant v1, KnownVariant v2, KnownVariant (v1 V.* v2)) => (ExactPi -> ExactPi -> ExactPi) -> (a -> a -> a) -> UnitNameTransformer2 -> Dimensional v1 d1 a -> Dimensional v2 d2 a -> Dimensional (v1 V.* v2) d3 a liftD2 fe f nt x1 x2 = let (x1', e1') = extractValue x1 (x2', e2') = extractValue x2 n1 = extractName x1 n2 = extractName x2 n' = (liftA2 nt) n1 n2 in injectValue n' (f x1' x2', fe <$> e1' <*> e2') -- Combines two dimensional values using a binary operation on values, yielding a Quantity. liftQ2 :: (a -> a -> a) -> Quantity d1 a -> Quantity d2 a -> Quantity d3 a liftQ2 = coerce dimensional-1.0.1.3/src/Numeric/Units/Dimensional/UnitNames/Internal.hs0000644000000000000000000003055512766531445024137 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} module Numeric.Units.Dimensional.UnitNames.Internal where import Control.Monad (join) import Data.Data #if MIN_VERSION_base(4, 8, 0) import Data.Foldable (toList) #else import Data.Foldable (Foldable, toList) #endif import GHC.Generics import Numeric.Units.Dimensional.Dimensions.TermLevel (Dimension', asList, HasDimension(..)) import Numeric.Units.Dimensional.UnitNames.InterchangeNames import Numeric.Units.Dimensional.Variants (Metricality(..)) import Prelude hiding ((*), (/), (^), product) import qualified Prelude as P -- | The name of a unit. data UnitName (m :: Metricality) where -- The name of the unit of dimensionless values. One :: UnitName 'NonMetric -- A name of an atomic unit to which metric prefixes may be applied. MetricAtomic :: NameAtom ('UnitAtom 'Metric) -> UnitName 'Metric -- A name of an atomic unit to which metric prefixes may not be applied. Atomic :: NameAtom ('UnitAtom 'NonMetric) -> UnitName 'NonMetric -- A name of a prefixed unit. Prefixed :: PrefixName -> UnitName 'Metric -> UnitName 'NonMetric -- A compound name formed from the product of two names. Product :: UnitName 'NonMetric -> UnitName 'NonMetric -> UnitName 'NonMetric -- A compound name formed from the quotient of two names. Quotient :: UnitName 'NonMetric -> UnitName 'NonMetric -> UnitName 'NonMetric -- A compound name formed by raising a unit name to an integer power. Power :: UnitName 'NonMetric -> Int -> UnitName 'NonMetric -- A compound name formed by grouping another name, which is generally compound. Grouped :: UnitName 'NonMetric -> UnitName 'NonMetric -- A weakened name formed by forgetting whether it could accept a metric prefix. -- Differs from 'Grouped' because it is displayed without parentheses. Weaken :: UnitName 'Metric -> UnitName 'NonMetric deriving (Typeable) deriving instance Eq (UnitName m) instance Show (UnitName m) where show One = "1" show (MetricAtomic a) = abbreviation_en a show (Atomic a) = abbreviation_en a show (Prefixed a n) = abbreviation_en a ++ show n show (Product n1 n2) = show n1 ++ " " ++ show n2 show (Quotient n1 n2) = show n1 ++ " / " ++ show n2 show (Power x n) = show x ++ "^" ++ show n show (Grouped n) = "(" ++ show n ++ ")" show (Weaken n) = show n isAtomic :: UnitName m -> Bool isAtomic (One) = True isAtomic (MetricAtomic _) = True isAtomic (Atomic _) = True isAtomic (Prefixed _ _) = True isAtomic (Grouped _) = True isAtomic (Weaken n) = isAtomic n isAtomic _ = False isAtomicOrProduct :: UnitName m -> Bool isAtomicOrProduct (Product _ _) = True isAtomicOrProduct n = isAtomic n -- reduce by algebraic simplifications reduce :: UnitName m -> UnitName m reduce (One) = One reduce n@(MetricAtomic _) = n reduce n@(Atomic _) = n reduce n@(Prefixed _ _) = n reduce (Product n1 n2) = reduce' (reduce n1 * reduce n2) reduce (Quotient n1 n2) = reduce' (reduce n1 * reduce n2) reduce (Power n x) = reduce' ((reduce n) ^ x) reduce (Grouped n) = reduce' (Grouped (reduce n)) reduce (Weaken n) = reduce' (Weaken (reduce n)) -- reduce, knowing that subterms are already in reduced form reduce' :: UnitName m -> UnitName m reduce' (Product One n) = reduce' n reduce' (Product n One) = reduce' n reduce' (Power (Power n x1) x2) = reduce (n ^ (x1 P.* x2)) reduce' (Power (Grouped (Power n x1)) x2) = reduce (n ^ (x1 P.* x2)) reduce' (Power _ 0) = One reduce' (Power n 1) = reduce' n reduce' (Grouped n) = reduce' n reduce' n@(Weaken (MetricAtomic _)) = n reduce' n = n data NameAtomType = UnitAtom Metricality | PrefixAtom deriving (Eq, Ord, Data, Typeable, Generic) -- | The name of a metric prefix. type PrefixName = NameAtom 'PrefixAtom nOne :: UnitName 'NonMetric nOne = One nMeter :: UnitName 'Metric nMeter = ucumMetric "m" "m" "metre" nGram :: UnitName 'Metric nGram = ucumMetric "g" "g" "gram" nKilogram :: UnitName 'NonMetric nKilogram = applyPrefix kilo nGram nSecond :: UnitName 'Metric nSecond = ucumMetric "s" "s" "second" nAmpere :: UnitName 'Metric nAmpere = ucumMetric "A" "A" "Ampere" nKelvin :: UnitName 'Metric nKelvin = ucumMetric "K" "K" "Kelvin" nMole :: UnitName 'Metric nMole = ucumMetric "mol" "mol" "mole" nCandela :: UnitName 'Metric nCandela = ucumMetric "cd" "cd" "candela" -- | The name of the base unit associated with a specified dimension. baseUnitName :: Dimension' -> UnitName 'NonMetric baseUnitName d = let powers = asList $ dimension d in reduce . product $ zipWith (^) baseUnitNames powers baseUnitNames :: [UnitName 'NonMetric] baseUnitNames = [weaken nMeter, nKilogram, weaken nSecond, weaken nAmpere, weaken nKelvin, weaken nMole, weaken nCandela] deka, hecto, kilo, mega, giga, tera, peta, exa, zetta, yotta :: PrefixName deka = prefix "da" "da" "deka" hecto = prefix "h" "h" "hecto" kilo = prefix "k" "k" "kilo" mega = prefix "M" "M" "mega" giga = prefix "G" "G" "giga" tera = prefix "T" "T" "tera" peta = prefix "P" "P" "peta" exa = prefix "E" "E" "exa" zetta = prefix "Z" "Z" "zetta" yotta = prefix "Y" "Y" "yotta" deci, centi, milli, micro, nano, pico, femto, atto, zepto, yocto :: PrefixName deci = prefix "d" "d" "deci" centi = prefix "c" "c" "centi" milli = prefix "m" "m" "milli" micro = prefix "u" "μ" "micro" nano = prefix "n" "n" "nano" pico = prefix "p" "p" "pico" femto = prefix "f" "f" "femto" atto = prefix "a" "a" "atto" zepto = prefix "z" "z" "zepto" yocto = prefix "y" "y" "yocto" -- | Forms a 'UnitName' from a 'Metric' name by applying a metric prefix. applyPrefix :: PrefixName -> UnitName 'Metric -> UnitName 'NonMetric applyPrefix = Prefixed {- We will reuse the operators and function names from the Prelude. To prevent unpleasant surprises we give operators the same fixity as the Prelude. -} infixr 8 ^ infixl 7 *, / -- | Form a 'UnitName' by taking the product of two others. (*) :: UnitName m1 -> UnitName m2 -> UnitName 'NonMetric a * b = Product (weaken a) (weaken b) -- | Form a 'UnitName' by dividing one by another. (/) :: UnitName m1 -> UnitName m2 -> UnitName 'NonMetric n1 / n2 | isAtomicOrProduct n1 = Quotient (weaken n1) (weaken n2) | otherwise = Quotient (grouped n1) (weaken n2) -- | Form a 'UnitName' by raising a name to an integer power. (^) :: UnitName m -> Int -> UnitName 'NonMetric x ^ n | isAtomic x = Power (weaken x) n | otherwise = Power (grouped x) n -- | Convert a 'UnitName' which may or may not be 'Metric' to one -- which is certainly 'NonMetric'. weaken :: UnitName m -> UnitName 'NonMetric weaken n@(MetricAtomic _) = Weaken n -- we really only need this one case and a catchall, but the typechecker can't see it weaken n@One = n weaken n@(Atomic _) = n weaken n@(Prefixed _ _) = n weaken n@(Product _ _) = n weaken n@(Quotient _ _) = n weaken n@(Power _ _) = n weaken n@(Grouped _) = n weaken n@(Weaken _) = n -- | Attempt to convert a 'UnitName' which may or may not be 'Metric' to one -- which is certainly 'Metric'. strengthen :: UnitName m -> Maybe (UnitName 'Metric) strengthen n@(MetricAtomic _) = Just n strengthen (Weaken n) = strengthen n strengthen _ = Nothing -- | Convert a 'UnitName' of one 'Metricality' into a name of the other metricality by -- strengthening or weakening if neccessary. Because it may not be possible to strengthen, -- the result is returned in a 'Maybe' wrapper. relax :: forall m1 m2.(Typeable m1, Typeable m2) => UnitName m1 -> Maybe (UnitName m2) relax n = go (typeRep (Proxy :: Proxy m1)) (typeRep (Proxy :: Proxy m2)) n where metric = typeRep (Proxy :: Proxy 'Metric) nonMetric = typeRep (Proxy :: Proxy 'NonMetric) go :: TypeRep -> TypeRep -> UnitName m1 -> Maybe (UnitName m2) go p1 p2 | p1 == p2 = cast | (p1 == nonMetric) && (p2 == metric) = join . fmap gcast . strengthen | (p1 == metric) && (p2 == nonMetric) = cast . weaken | otherwise = error "Should be unreachable. TypeRep of an unexpected Metricality encountered." -- | Constructs a 'UnitName' by applying a grouping operation to -- another 'UnitName', which may be useful to express precedence. grouped :: UnitName m -> UnitName 'NonMetric grouped = Grouped . weaken -- | Represents the name of an atomic unit or prefix. data NameAtom (m :: NameAtomType) = NameAtom { _interchangeName :: InterchangeName, -- ^ The interchange name of the unit. abbreviation_en :: String, -- ^ The abbreviated name of the unit in international English name_en :: String -- ^ The full name of the unit in international English } deriving (Eq, Ord, Data, Typeable, Generic) instance HasInterchangeName (NameAtom m) where interchangeName = _interchangeName instance HasInterchangeName (UnitName m) where interchangeName One = InterchangeName { name = "1", authority = UCUM } interchangeName (MetricAtomic a) = interchangeName a interchangeName (Atomic a) = interchangeName a interchangeName (Prefixed p n) = let n' = (name . interchangeName $ p) ++ (name . interchangeName $ n) a' = max (authority . interchangeName $ p) (authority . interchangeName $ n) in InterchangeName { name = n', authority = a' } interchangeName (Product n1 n2) = let n' = (name . interchangeName $ n1) ++ "." ++ (name . interchangeName $ n2) a' = max (authority . interchangeName $ n1) (authority . interchangeName $ n2) in InterchangeName { name = n', authority = a' } interchangeName (Quotient n1 n2) = let n' = (name . interchangeName $ n1) ++ "/" ++ (name . interchangeName $ n2) a' = max (authority . interchangeName $ n1) (authority . interchangeName $ n2) in InterchangeName { name = n', authority = a' } interchangeName (Power n x) = let n' = (name . interchangeName $ n) ++ (show x) in InterchangeName { name = n', authority = authority . interchangeName $ n } interchangeName (Grouped n) = let n' = "(" ++ (name . interchangeName $ n) ++ ")" in InterchangeName { name = n', authority = authority . interchangeName $ n } interchangeName (Weaken n) = interchangeName n prefix :: String -> String -> String -> PrefixName prefix i a f = NameAtom (InterchangeName i UCUM) a f ucumMetric :: String -> String -> String -> UnitName 'Metric ucumMetric i a f = MetricAtomic $ NameAtom (InterchangeName i UCUM) a f ucum :: String -> String -> String -> UnitName 'NonMetric ucum i a f = Atomic $ NameAtom (InterchangeName i UCUM) a f dimensionalAtom :: String -> String -> String -> UnitName 'NonMetric dimensionalAtom i a f = Atomic $ NameAtom (InterchangeName i DimensionalLibrary) a f -- | Constructs an atomic name for a custom unit. atom :: String -- ^ Interchange name -> String -- ^ Abbreviated name in international English -> String -- ^ Full name in international English -> UnitName 'NonMetric atom i a f = Atomic $ NameAtom (InterchangeName i Custom) a f -- | The type of a unit name transformation that may be associated with an operation that takes a single unit as input. type UnitNameTransformer = (forall m.UnitName m -> UnitName 'NonMetric) -- | The type of a unit name transformation that may be associated with an operation that takes two units as input. type UnitNameTransformer2 = (forall m1 m2.UnitName m1 -> UnitName m2 -> UnitName 'NonMetric) -- | Forms the product of a list of 'UnitName's. -- -- If you wish to form a heterogenous product of 'Metric' and 'NonMetric' units -- you should apply 'weaken' to the 'Metric' ones. product :: Foldable f => f (UnitName 'NonMetric) -> UnitName 'NonMetric product = go . toList where -- This is not defined using a simple fold so that it does not complicate the product with -- valid but meaningless occurences of nOne. go :: [UnitName 'NonMetric] -> UnitName 'NonMetric go [] = nOne go [n] = n go (n : ns) = n * go ns dimensional-1.0.1.3/tests/Test.hs0000644000000000000000000000052212766531445014773 0ustar0000000000000000import qualified Numeric.Units.Dimensional.Test import qualified Numeric.Units.Dimensional.QuantitiesTest import System.Exit main :: IO () main = do Numeric.Units.Dimensional.QuantitiesTest.main ok <- Numeric.Units.Dimensional.Test.main if ok then exitSuccess else exitFailure dimensional-1.0.1.3/tests/Numeric/Units/Dimensional/QuantitiesTest.hs0000644000000000000000000000760712766531445024023 0ustar0000000000000000module Numeric.Units.Dimensional.QuantitiesTest where import Numeric.Units.Dimensional.Prelude import qualified Prelude -- These definitions simply verify that the type synonyms are -- consistent with the appropriate units from table 2. If the -- definitions compile the type synonyms are good. x1 :: Area Double x1 = 1 *~ meter ^ pos2 x2 :: Volume Double x2 = 1 *~ meter ^ pos3 x3 :: Velocity Double x3 = 1 *~ (meter / second) x4 :: Acceleration Double x4 = 1 *~ (meter / second ^ pos2) x5 :: WaveNumber Double x5 = 1 *~ meter ^ neg1 x6 :: Density Double x6 = 1 *~ (kilo gram / meter ^ pos3) x7 :: SpecificVolume Double x7 = 1 *~ (meter ^ pos3 / kilo gram) x8 :: CurrentDensity Double x8 = 1 *~ (ampere / meter ^ pos2) x9 :: MagneticFieldStrength Double x9 = 1 *~ (ampere / meter) x10 :: Concentration Double x10 = 1 *~ (mole / meter ^ pos3) x11 :: Luminance Double x11 = 1 *~ (candela / meter ^ pos2) -- These definitions simply verify that the type synonyms are -- consistent with the appropriate units from table 3. If the -- definitions compile the type synonyms are good. y1 :: PlaneAngle Double y1 = 1 *~ (meter / meter) y2 :: SolidAngle Double y2 = 1 *~ (meter ^ pos2 / meter ^ pos2) y3 :: Frequency Double y3 = 1 *~ (one / second) y4 :: Force Double y4 = 1 *~ (meter * kilo gram / second ^ pos2) y5 :: Pressure Double y5 = 1 *~ (newton / meter ^ pos2) y6 :: Energy Double y6 = 1 *~ (newton * meter) y7 :: Power Double y7 = 1 *~ (joule / second) y8 :: ElectricCharge Double y8 = 1 *~ (second * ampere) y9 :: ElectricPotential Double y9 = 1 *~ (watt / ampere) y10 :: Capacitance Double y10 = 1 *~ (coulomb / volt) y11 :: ElectricResistance Double y11 = 1 *~ (volt / ampere) y12 :: ElectricConductance Double y12 = 1 *~ (ampere / volt) y13 :: MagneticFlux Double y13 = 1 *~ (volt * second) y14 :: MagneticFluxDensity Double y14 = 1 *~ (weber / meter ^ pos2) y15 :: Inductance Double y15 = 1 *~ (weber / ampere) y16 :: LuminousFlux Double y16 = 1 *~ (candela * steradian) y17 :: Illuminance Double y17 = 1 *~ (lumen / meter ^ pos2) y18 :: Activity Double y18 = 1 *~ (one / second) y19 :: AbsorbedDose Double y19 = 1 *~ (joule / kilo gram) y20 :: DoseEquivalent Double y20 = 1 *~ (joule / kilo gram) y21 :: CatalyticActivity Double y21 = 1 *~ (mole / second) -- Verification of table 4. If the definitions compile the type -- synonyms are good. z1 :: AngularVelocity Double z1 = 1 *~ (radian / second) z2 :: AngularAcceleration Double z2 = 1 *~ (radian / second ^ pos2) z3 :: DynamicViscosity Double z3 = 1 *~ (pascal * second) z4 :: MomentOfForce Double z4 = 1 *~ (newton * meter) z5 :: SurfaceTension Double z5 = 1 *~ (newton / meter) z6 :: HeatFluxDensity Double z6 = 1 *~ (watt / meter ^ pos2) z7 :: RadiantIntensity Double z7 = 1 *~ (watt / steradian) z8 :: Radiance Double z8 = 1 *~ (watt / (meter ^ pos2 * steradian)) z9 :: HeatCapacity Double z9 = 1 *~ (joule / kelvin) z10 :: SpecificHeatCapacity Double z10 = 1 *~ (joule / (kilo gram * kelvin)) z11 :: ThermalConductivity Double z11 = 1 *~ (watt / (meter * kelvin)) z12 :: EnergyDensity Double z12 = 1 *~ (joule / meter ^ pos3) z13 :: ElectricFieldStrength Double z13 = 1 *~ (volt / meter) z14 :: ElectricChargeDensity Double z14 = 1 *~ (coulomb / meter ^ pos3) z15 :: ElectricFluxDensity Double z15 = 1 *~ (coulomb / meter ^ pos2) z16 :: Permittivity Double z16 = 1 *~ (farad / meter) z17 :: Permeability Double z17 = 1 *~ (henry / meter) z18 :: MolarEnergy Double z18 = 1 *~ (joule / mole) z19 :: MolarEntropy Double z19 = 1 *~ (joule / (mole * kelvin)) z20 :: Exposure Double z20 = 1 *~ (coulomb / kilo gram) z21 :: AbsorbedDoseRate Double z21 = 1 *~ (gray / second) -- Other quantitites. mu :: GravitationalParameter Double mu = 398600.4418 *~ (kilo meter ^ pos3 / second ^ pos2) -- Dummy main function. main :: IO () main = Prelude.putStrLn "If I compiled I'm OK!" dimensional-1.0.1.3/tests/Numeric/Units/Dimensional/Test.hs0000644000000000000000000000457412766531445021754 0ustar0000000000000000{-# LANGUAGE NoMonomorphismRestriction #-} module Numeric.Units.Dimensional.Test where import Numeric.Units.Dimensional.Prelude import qualified Prelude import Test.HUnit testPower :: Test testPower = TestLabel "Power test" $ TestList [ TestCase $ ((9::Double) *~ one) @=? (3 *~ one) ^ pos2 , TestCase $ ((1::Double) *~ one) @=? (12.1231 *~ one) ^ zero , TestCase $ ((0.25::Double) *~ one) @=? (2 *~ one) ^ neg2 ] testDimensionless :: Test testDimensionless = TestLabel "Dimensionless test" $ TestList [ TestCase $ (3 Prelude.** 2::Double) *~ one @=? (3 *~ one) ** (2 *~ one) ] testShow :: Test testShow = TestLabel "Test 'Show' instance" $ TestList [ TestCase $ show ((1.0::Double) *~ one) @?= "1.0" , TestCase $ show ((2.0::Double) *~ meter) @?= "2.0 m" , TestCase $ show ((2.0::Double) *~ (meter / second)) @?= "2.0 m s^-1" , TestCase $ show ((2.0::Double) *~ (meter ^ pos2 / second ^ pos2)) @?= "2.0 m^2 s^-2" --, TestCase $ show (undefined :: DimRep DVelocity) @?= "m s^-1" ] testOrdering :: Test testOrdering = TestLabel "Test 'Ord' instance" $ TestList [ TestCase $ compare ((1 :: Integer) *~ one) (3 *~ one) @?= LT , TestCase $ compare ((1 :: Double) *~ (kilo meter)) (1 *~ meter) @?= GT , TestCase $ compare ((0 :: Double) *~ second) (_0) @?= EQ ] testNFromTo :: Test testNFromTo = TestLabel "Test enumeration function 'nFromTo'" $ TestList [ TestCase $ nFromTo' _1 _6 0 @?= [_1, _6] , TestCase $ nFromTo' _1 _6 (-1) @?= [_1, _6] , TestCase $ nFromTo' _1 _3 1 @?= [_1, _2, _3] , TestCase $ nFromTo' _1 _6 4 @?= [_1, _2, _3, _4, _5, _6] , TestCase $ nFromTo' _5 _2 2 @?= [_5, _4, _3, _2] , TestCase $ nFromTo' _0 _6 2 @?= [_0, _2, _4, _6] , TestCase $ nFromTo' _6 _0 2 @?= [_6, _4, _2, _0] , TestCase $ nFromTo' _1 _1 0 @?= [_1, _1] , TestCase $ nFromTo' _0 _0 2 @?= [_0, _0, _0, _0] ] where nFromTo' :: Dimensionless Double -> Dimensionless Double -> Int -> [Dimensionless Double] nFromTo' = nFromTo -- Collect the test cases. tests :: Test tests = TestList [ testPower , testDimensionless , testShow , testOrdering , testNFromTo ] main :: IO Bool -- True means everything passed main = do res <- runTestTT tests return $ (errors res == 0) && (failures res == 0) dimensional-1.0.1.3/benchmarks/Main.hs0000644000000000000000000000102512627647654015720 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} module Main where import Criterion.Main import Numeric.Units.Dimensional.Prelude import qualified Prelude as P main :: IO () main = defaultMain [ bench "RawArithmetic" $ nf rawArithmetic 1000 , bench "Arithmetic" $ nf arithmetic 1000 ] rawArithmetic :: Int -> [Double] rawArithmetic n = fmap (P./ 3.7) $ [1.0 .. fromIntegral n] arithmetic :: Int -> [Density Double] arithmetic n = fmap (/ (3.7 *~ cubic meter)) $ [1.0 .. fromIntegral n] *~~ kilo gram dimensional-1.0.1.3/LICENSE0000644000000000000000000000301512627647654013371 0ustar0000000000000000Copyright (c) 2006-2014, Bjorn Buckwalter. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder(s) nor the names of contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. dimensional-1.0.1.3/Setup.lhs0000644000000000000000000000011512627647654014172 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMaindimensional-1.0.1.3/dimensional.cabal0000644000000000000000000000744612766531473015661 0ustar0000000000000000name: dimensional version: 1.0.1.3 license: BSD3 license-file: LICENSE copyright: Bjorn Buckwalter 2006-2015 author: Bjorn Buckwalter maintainer: bjorn@buckwalter.se stability: experimental homepage: https://github.com/bjornbm/dimensional/ category: Math, Physics synopsis: Statically checked physical dimensions, using Type Families and Data Kinds. cabal-version: >= 1.10 tested-with: GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2 build-type: Simple description: Dimensional is a library providing data types for performing arithmetic with physical quantities and units. Information about the physical dimensions of the quantities and units is embedded in their types and the validity of operations is verified by the type checker at compile time. The boxing and unboxing of numerical values as quantities is done by multiplication and division with units. The library is designed to, as far as is practical, enforce/encourage best practices of unit usage. Version 1 of the dimensional package differs from earlier version in that the dimension tracking is implemented using Closed Type Families and Data Kinds rather than functional dependencies. This enables a number of features, including improved support for unit names and quantities with statically-unknown dimensions. Requires GHC 7.8 or later. extra-source-files: README.md, CHANGELOG.md, examples/ReadmeExample.hs, examples/GM.lhs source-repository head type: git location: https://github.com/bjornbm/dimensional/ library build-depends: base >= 4.7 && < 5, deepseq >= 1.3, exact-pi >= 0.2.1.1 && < 0.5, numtype-dk >= 0.5 && < 1.1, vector >= 0.10 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall exposed-modules: Numeric.Units.Dimensional, Numeric.Units.Dimensional.Coercion, Numeric.Units.Dimensional.Prelude, Numeric.Units.Dimensional.Quantities, Numeric.Units.Dimensional.SIUnits, Numeric.Units.Dimensional.NonSI, Numeric.Units.Dimensional.Dimensions, Numeric.Units.Dimensional.Dimensions.TermLevel, Numeric.Units.Dimensional.Dimensions.TypeLevel, Numeric.Units.Dimensional.Dynamic, Numeric.Units.Dimensional.Functor, Numeric.Units.Dimensional.UnitNames, Numeric.Units.Dimensional.UnitNames.InterchangeNames, Numeric.Units.Dimensional.Variants other-modules: Numeric.Units.Dimensional.Internal, Numeric.Units.Dimensional.UnitNames.Internal test-suite tests type: exitcode-stdio-1.0 main-is: Test.hs hs-source-dirs: tests other-modules: Numeric.Units.Dimensional.QuantitiesTest, Numeric.Units.Dimensional.Test default-language: Haskell2010 ghc-options: -Wall build-depends: dimensional, HUnit, base benchmark simple type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Main.hs build-depends: base, criterion, deepseq, dimensional default-language: Haskell2010 ghc-options: -O2 dimensional-1.0.1.3/README.md0000644000000000000000000000642112766531445013641 0ustar0000000000000000# dimensional This library provides statically-checked dimensional arithmetic for physical quantities, using the 7 SI base dimensions. Data kinds and closed type families provide a flexible, safe, and discoverable implementation that leads to largely self-documenting client code. [![Build Status](https://travis-ci.org/bjornbm/dimensional.svg?branch=master)](https://travis-ci.org/bjornbm/dimensional) [![Hackage Version](http://img.shields.io/hackage/v/dimensional.svg)](http://hackage.haskell.org/package/dimensional) ## Usage Simply importing `Numeric.Units.Dimensional.Prelude` provides access to dimensional arithmetic opertors, SI units and other common units accepted for use with the SI, and convenient aliases for quantities with commonly used dimensions. The `Unit d a` type represents a unit with dimension `d`, whose conversion factor to the coherent SI base unit of the corresponding dimension is represented by a value of type `a`. `a` is commonly chosen to be `Double`, but can be any `Floating` type. Where possible, support is also provided for `Fractional` or `Num` values. Similarly, the `Quantity d a` type represents a quantity with dimension `d`, whose numeric value is of type `a`. Aliases allow the use of, e.g., `Length Double` to mean `Quantity DLength Double`. A complete list of available aliases is given in the haddock documentation for the `Numeric.Units.Dimensional.Quantities`. In the example below, we will solve a simple word problem. A car travels at 60 kilometers per hour for one mile, at 50 kph for one mile, at 40 kph for one mile, and at 30 kph for one mile. How many minutes does the journey take? What is the average speed of the car? How many seconds does the journey take, rounded up to the next whole second? ```haskell {-# LANGUAGE NoImplicitPrelude #-} module ReadmeExample where import Numeric.Units.Dimensional.Prelude import Numeric.Units.Dimensional.NonSI (mile) leg :: Length Double leg = 1 *~ mile -- *~ combines a raw number and a unit to form a quantity speeds :: [Velocity Double] speeds = [60, 50, 40, 30] *~~ (kilo meter / hour) -- *~~ does the same thing for a whole Functor at once -- Parentheses are required around unit expressions that are comingled with *~, /~, *~~, or /~~ operations timeOfJourney :: Time Double timeOfJourney = sum $ fmap (leg /) speeds -- We can use dimensional versions of ordinary functions like / and sum to combine quantities averageSpeed :: Velocity Double averageSpeed = _4 * leg / timeOfJourney -- _4 is an alias for the dimensionless number 4 wholeSeconds :: Integer wholeSeconds = ceiling $ timeOfJourney /~ second -- /~ lets us recover a raw number from a quantity and a unit in which it should be expressed main :: IO () main = do putStrLn $ "Length of journey is: " ++ showIn minute timeOfJourney putStrLn $ "Average speed is: " ++ showIn (mile / hour) averageSpeed putStrLn $ "If we don't want to be explicit about units, the show instance uses the SI basis: " ++ show averageSpeed putStrLn $ "The journey requires " ++ show wholeSeconds ++ " seconds, rounded up to the nearest second." ``` ## Contributing For project information (issues, updates, wiki, examples) see: https://github.com/bjornbm/dimensional dimensional-1.0.1.3/CHANGELOG.md0000644000000000000000000000457212766531473014201 0ustar00000000000000001.0.1.3 (2016-09) ----------------- * Fixed an issue with applying metric prefixes to units with non-rational conversion factors. 1.0.1.2 (2016-05) ----------------- * Support for GHC 8.0.1-rc4, avoiding GHC Trac issue 12026. * Added support for stack. 1.0.1.1 (2015-11) ----------------- * Improved example in readme. 1.0.1.0 (2015-11) ----------------- * Added Numeric.Units.Dimensional.Coercion module. * Bumped exact-pi dependency to < 0.5. * Restored changelog. * Addressed issues with documentation. 1.0.0.0 (2015-11) ----------------- * Changed to DataKinds and ClosedTypeFamilies encoding of dimensions. * Added names and exact values to `Unit`s. * Added `AnyUnit` and `AnyQuantity` for quantities whose dimension is statically unknown. * Added Storable and Unbox instances for `Quantity`. * Added dimensionally-polymorphic `siUnit` for the coherent SI base unit of any dimension. * Added some additional units. 0.13.0.2 (2015-04) ------------------ * Corrected definition of lumen. 0.13.0.1 (2014-09) ------------------ * Bumped time dependency to < 1.6. 0.13 (2014-02) -------------- * Bump major version (should have been done in previous version). 0.12.3 (2014-02) ---------------- * Bump numtype dependency to 1.1 (GHC 7.8.1 compatibility fix). * Added `Torque`. * Added D.. for the type synonym quantities (e.g., `Angle`). 0.12.2 (2013-11) ---------------- * Added `FirstMassMoment`, `MomentOfInertia`, `AngularMomentum`. * Improved unit numerics. 0.12.1 (2013-07) ---------------- * Typeable Dimensionals. 0.12 (2013-06) -------------- * Polymorphic `_0` (closes issue 39). * Added `astronomicalUnit`. * Added imperial volume units. * Added 'mil' (=inch/1000). * Added [`tau`][3]. * Added `KinematicViscosity`. [3]: http://tauday.com/tau-manifesto 0.10.1.2 (2011-09) ------------------ * Bumped time dependency to < 1.5. 0.10.1.2 (2011-08) ------------------ * Bumped time dependency to < 1.4. 0.10.1 (2011-08) ---------------- GHC 7.2.1 compatibility fix: * Increased CGS context-stack to 30. 0.10 (2011-05) -------------- See the [announcement][2]. [2]: http://flygdynamikern.blogspot.se/2011/05/announce-dimensional-010.html 0.9 (2011-04) ------------- See the [announcement][1]. [1]: http://flygdynamikern.blogspot.se/2011/04/announce-dimensional-09.html dimensional-1.0.1.3/examples/ReadmeExample.hs0000644000000000000000000000257612641324764017250 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} module ReadmeExample where import Numeric.Units.Dimensional.Prelude import Numeric.Units.Dimensional.NonSI (mile) leg :: Length Double leg = 1 *~ mile -- *~ combines a raw number and a unit to form a quantity speeds :: [Velocity Double] speeds = [60, 50, 40, 30] *~~ (kilo meter / hour) -- *~~ does the same thing for a whole Functor at once -- Parentheses are required around unit expressions that are comingled with *~, /~, *~~, or /~~ operations timeOfJourney :: Time Double timeOfJourney = sum $ fmap (leg /) speeds -- We can use dimensional versions of ordinary functions like / and sum to combine quantities averageSpeed :: Velocity Double averageSpeed = _4 * leg / timeOfJourney -- _4 is an alias for the dimensionless number 4 wholeSeconds :: Integer wholeSeconds = ceiling $ timeOfJourney /~ second -- /~ lets us recover a raw number from a quantity and a unit in which it should be expressed main :: IO () main = do putStrLn $ "Length of journey is: " ++ showIn minute timeOfJourney putStrLn $ "Average speed is: " ++ showIn (mile / hour) averageSpeed putStrLn $ "If we don't want to be explicit about units, the show instance uses the SI basis: " ++ show averageSpeed putStrLn $ "The journey requires " ++ show wholeSeconds ++ " seconds, rounded up to the nearest second." dimensional-1.0.1.3/examples/GM.lhs0000644000000000000000000000553212627647654015223 0ustar0000000000000000 = GM calculation = Several representation can be used to describe a satellite's orbit. Two of the most popular are the cartesian state vector (position and velocity vectors) and the keplerian elements. Conversion between the two representations is fairly straight-forward but requires an assumption to be made about the universal gravitational constant 'G' and the mass 'M' of the body the satellite is orbiting. In practice they are often combined into a parameter "mu = GM" where the magnitude of 'mu' is empirically better known that the magnitudes of 'G' and 'M' individually. *The problem:* Given two representations of the same satellite orbit -- one using the cartesian state vector and using keplerian elements, both at the same epoch -- determine the value of 'mu' used to convert between the two. {{{ > {-# LANGUAGE NegativeLiterals #-} > module GM where > import Numeric.Units.Dimensional.Prelude > import qualified Prelude }}} The state vector describing the orbit at epoch. {{{ > x = 4383.9449203752 *~ kilo meter > y = -41940.917505092 *~ kilo meter > z = 22.790255916589 *~ kilo meter > x_dot = 3.0575666627812 *~ (kilo meter / second) > y_dot = 0.32047068607303 *~ (kilo meter / second) > z_dot = 0.00084729371755294 *~ (kilo meter / second) }}} From the state vector we calculate the distance from the reference frame center at epoch and the velocity squared at epoch. {{{ > r = sqrt (x ^ pos2 + y ^ pos2 + z ^ pos2) > v = sqrt (x_dot ^ pos2 + y_dot ^ pos2 + z_dot ^ pos2) }}} The kinetic energy per unit mass at epoch is a function of the velocity. {{{ > e_kin :: EnergyPerUnitMass Double > e_kin = v ^ pos2 / _2 }}} The only keplerian element we need for this calculation is the semi-major axis. {{{ > semi_major_axis = 42165.221455 *~ kilo meter }}} The expression for 'mu' is obtained by solving the following equation system: e_pot = - mu / r, e_tot = - mu / 2a, e_tot = e_pot + e_kin, which gives: mu = e_kin / (1 / r - 1 / 2a). {{{ > mu = e_kin / (_1 / r - _1 / (_2 * semi_major_axis)) }}} Wrap up with a main function showing the value of 'mu' in desired units. {{{ > main = putStrLn $ "The value used for GM was " ++ show mu }}} Loading this module in 'ghci' and running 'main' produces the following output. {{{ ___ ___ _ / _ \ /\ /\/ __(_) / /_\// /_/ / / | | GHC Interactive, version 6.6.1, for Haskell 98. / /_\\/ __ / /___| | http://www.haskell.org/ghc/ \____/\/ /_/\____/|_| Type :? for help. Loading package base ... linking ... done. [1 of 1] Compiling GM ( GM.lhs, interpreted ) Ok, modules loaded: GM. *GM> main Loading package dimensional-0.5 ... linking ... done. The value used for GM was 3.986004400008003e14 m^3 s^-2 *GM> }}}