packages feed

units 2.0 → 2.1

raw patch · 55 files changed

+4653/−646 lines, 55 filesdep +HUnit-approxdep +containersdep +mtldep ~basedep ~singletons

Dependencies added: HUnit-approx, containers, mtl, multimap, parsec, syb, tasty, tasty-hunit, template-haskell, th-desugar, vector-space

Dependency ranges changed: base, singletons

Files

CHANGES.md view
@@ -1,3 +1,49 @@+Version 2.1+-----------++* Includes a decently comprehensive test suite.++* Add support for unit parsing within expressions:++      g = 9.8 % [si| m/s^2 |]++  See `Data.Metrology.Parser`.++* Now, `Data.Metrology` exports operators that work with the default+  LCSU. Use `Data.Metrology.Poly` to get the old, more flexible operators.++* Moved `showIn` from `Data.Metrology.Show` to `Data.Metrology.Poly`. This+  allows users to import `showIn` without a `Show` instance for quantities.++* Numeric operations are available based on vector spaces, as implemented in+  the `vector-space` library. See `Data.Metrology.Vector`.++* Some documentation cleanup.++* New function `evalType` that evaluates a type, using Template Haskell. This+  allows for easier instance declarations for quantities.++* New class `Quantity` that allows for easy conversions with non-`units` types.++* A few bugfixes.++* The `Eq` and `Ord` instances now work over any quantity, not just dimensionless ones.++* New functions in `Data.Metrology.TH` that define `Dimension` and `Unit` instances+  for you.++Version 2.0+-----------++This is a major update. `units` now supports the notion of a local unit set+and of separable dimensions and units. See the description in the+[draft paper](http://www.cis.upenn.edu/~eir/papers/2014/units/units.pdf) for+more info.++This update will very likely break any code that used `units-1.x`.++The update was written in partnership with Takayuki Muranushi.+ Version 1.1 -----------
Data/Metrology.hs view
@@ -1,7 +1,7 @@ {- Data/Metrology.hs     The units Package-   Copyright (c) 2013 Richard Eisenberg+   Copyright (c) 2014 Richard Eisenberg    eir@cis.upenn.edu     This file gathers and exports all user-visible pieces of the units package.@@ -21,14 +21,10 @@      :     units & dimensions, at both type and term levels -} -{-# LANGUAGE ExplicitNamespaces, DataKinds, FlexibleInstances, TypeFamilies,-             TypeOperators, ConstraintKinds, ScopedTypeVariables,-             FlexibleContexts #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Data.Metrology--- Copyright   :  (C) 2013 Richard Eisenberg+-- Copyright   :  (C) 2014 Richard Eisenberg -- License     :  BSD-style (see LICENSE) -- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu) -- Stability   :  experimental@@ -45,84 +41,30 @@ -- synonym declarations are always included.) If a symbol is not exported, -- you do /not/ need to know anything about it to use this package. ----- Though it doesn't appear here, @Scalar@ is an instance of @Num@, and+-- Though it doesn't appear here, @Count@ is an instance of @Num@, and -- generally has all the numeric instances that @Double@ has.+--+-- This module exports definitions that lack unit-polymorphism. If you wish+-- to write more polymorphic code, see 'Data.Metrology.Poly'. If you wish+-- to use the numerical hierarchy from the @vector-space@ package, see+-- 'Data.Metrology.Vector'. ----------------------------------------------------------------------------- -module Data.Metrology (-  -- * Term-level combinators--  -- | The term-level arithmetic operators are defined by-  -- applying vertical bar(s) to the sides the dimensioned -  -- quantities acts on. -  -- See also "Data.Metrology.AltOperators" for an alternative system of operators.-  (|+|), (|-|), -  (|*|), (|/|), (*|),  (|*), (/|), (|/), -  (|^), (|^^),-  (|<|), (|>|), (|<=|), (|>=|), (|==|), (|/=|),-  qApprox, qNapprox,        -  qSq, qCube, qSqrt, qCubeRoot, nthRoot, --  -- * Nondimensional units, conversion between quantities and numeric values-  unity, zero, redim, convert,-  numIn, (#), (##), quOf, (%), (%%), defaultLCSU, fromDefaultLCSU,-  constant,--  -- * Type-level unit combinators-  (:*)(..), (:/)(..), (:^)(..), (:@)(..),-  UnitPrefix(..),--  -- * Type-level quantity combinators-  type (%*), type (%/), type (%^),--  -- * Creating quantity types-  Qu, MkQu_D, MkQu_DLN, MkQu_U, MkQu_ULN, --  -- * Creating new dimensions-  Dimension,--  -- * Creating new units-  Unit(type BaseUnit, type DimOfUnit, conversionRatio), -  Canonical,--  -- * Scalars, the only built-in unit-  Dimensionless(..), Number(..), Scalar, scalar,--  -- * LCSUs (locally coherent system of units)-  MkLCSU, LCSU(DefaultLCSU), DefaultUnitOfDim,--  -- * Validity checks and assertions-  CompatibleUnit, CompatibleDim, ConvertibleLCSUs_D,-  DefaultConvertibleLCSU_D, DefaultConvertibleLCSU_U,--  -- * Type-level integers-  Z(..), Succ, Pred, type (#+), type (#-), type (#*), type (#/), NegZ,--  -- ** Synonyms for small numbers-  One, Two, Three, Four, Five, MOne, MTwo, MThree, MFour, MFive,+{-# LANGUAGE TypeOperators, ConstraintKinds, DataKinds #-} -  -- ** Term-level singletons-  pZero, pOne, pTwo, pThree, pFour, pFive,-  pMOne, pMTwo, pMThree, pMFour, pMFive,-  pSucc, pPred,+module Data.Metrology (+  -- * Operators working with a default LCSU+  numIn, (#), quOf, (%), Count, -  -- * Internal definitions-  -- | The following module is re-exported solely to prevent noise in error messages;-  -- we do not recommend trying to use these definitions in user code.-  module Data.Metrology.Internal+  -- * The rest of the @units@ package interface. +  -- | Though Haddock doesn't show it, the polymorphic versions of 'numIn',+  -- '#', 'quOf', '%', and 'Count' are not re-exported.+  module Data.Metrology.Poly   ) where -import Data.Metrology.Z-import Data.Metrology.Quantity-import Data.Metrology.Dimensions-import Data.Metrology.Factor-import Data.Metrology.Units-import Data.Metrology.Combinators-import Data.Metrology.LCSU-import Data.Metrology.Validity-import Data.Metrology.Internal-import Data.Proxy+import Data.Metrology.Poly hiding ( numIn, (#), quOf, (%), Count )+import qualified Data.Metrology.Poly as Poly  -- | Extracts a numerical value from a dimensioned quantity, expressed in --   the given unit. For example:@@ -133,30 +75,18 @@ --   or -- --   > inMeters x = x # Meter   -numIn :: forall unit dim lcsu n.-         ( ValidDLU dim lcsu unit+numIn :: ( ValidDLU dim DefaultLCSU unit          , Fractional n )-      => Qu dim lcsu n -> unit -> n-numIn (Qu val) u-  = val * fromRational-            (canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu))-             / canonicalConvRatio u)+      => Qu dim DefaultLCSU n -> unit -> n+numIn = Poly.numIn  infix 5 # -- | Infix synonym for 'numIn'-(#) :: ( ValidDLU dim lcsu unit+(#) :: ( ValidDLU dim DefaultLCSU unit        , Fractional n )-    => Qu dim lcsu n -> unit -> n+    => Qu dim DefaultLCSU n -> unit -> n (#) = numIn -infix 5 ##--- | Like '#', but uses a default LCSU. This operator is recommended--- for users who wish not to worry about LCSUs.-(##) :: ( ValidDLU dim DefaultLCSU unit-        , Fractional n )-     => Qu dim DefaultLCSU n -> unit -> n-(##) = numIn- -- | Creates a dimensioned quantity in the given unit. For example: -- --   > height :: Length@@ -165,102 +95,19 @@ --   or -- --   > height = 2.0 % Meter-quOf :: forall unit dim lcsu n.-         ( ValidDLU dim lcsu unit-         , Fractional n )-      => n -> unit -> Qu dim lcsu n-quOf d u-  = Qu (d * fromRational-               (canonicalConvRatio u-                / canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu))))+quOf :: ( ValidDLU dim DefaultLCSU unit+        , Fractional n )+      => n -> unit -> Qu dim DefaultLCSU n+quOf = Poly.quOf  infixr 9 % -- | Infix synonym for 'quOf'-(%) :: ( ValidDLU dim lcsu unit+(%) :: ( ValidDLU dim DefaultLCSU unit        , Fractional n )-    => n -> unit -> Qu dim lcsu n+    => n -> unit -> Qu dim DefaultLCSU n (%) = quOf -infixr 9 %%--- | Like '%', but uses a default LCSU. This operator is recommended--- for users who wish not to worry about LCSUs.-(%%) :: ( ValidDLU dim DefaultLCSU unit-        , Fractional n )-     => n -> unit -> Qu dim DefaultLCSU n-(%%) = quOf---- | Use this to choose a default LCSU for a dimensioned quantity.--- The default LCSU uses the 'DefaultUnitOfDim' representation for each--- dimension.-defaultLCSU :: Qu dim DefaultLCSU n -> Qu dim DefaultLCSU n-defaultLCSU = id---- | The number 1, expressed as a unitless dimensioned quantity.-unity :: Num n => Qu '[] l n-unity = Qu 1---- | The number 0, polymorphic in its dimension. Use of this will--- often require a type annotation.-zero :: Num n => Qu dimspec l n-zero = Qu 0---- | Cast between equivalent dimension within the same CSU.---  for example [kg m s] and [s m kg]. See the README for more info.-redim :: (d @~ e) => Qu d l n -> Qu e l n-redim (Qu x) = Qu x---- | Dimension-keeping cast between different CSUs.-convert :: forall d l1 l2 n. -  ( ConvertibleLCSUs d l1 l2-  , Fractional n ) -  => Qu d l1 n -> Qu d l2 n-convert (Qu x) = Qu $ x * fromRational (-  canonicalConvRatioSpec (Proxy :: Proxy (LookupList d l1))-  / canonicalConvRatioSpec (Proxy :: Proxy (LookupList d l2)))----- | Compute the argument in the DefaultLCSU, and present the result--- as lcsu-polymorphic dimension-polymorphic value.-fromDefaultLCSU :: ( d @~ e-                   , ConvertibleLCSUs e DefaultLCSU l-                   , Fractional n )-         => Qu d DefaultLCSU n -> Qu e l n-fromDefaultLCSU = convert . redim----- | A synonym of 'fromDefaultLCSU', for one of its dominant usecase--- is to inject constant quantities into dimension-polymorphic--- expressions.-constant :: ( d @~ e-            , ConvertibleLCSUs e DefaultLCSU l-            , Fractional n )-         => Qu d DefaultLCSU n -> Qu e l n-constant = fromDefaultLCSU------------------------------------------------------------------- "Number" unit ------------------------------------------------------------------------------------------------------------- | The dimension for the dimensionless quantities.--- It is also called "quantities of dimension one", but--- @One@ is confusing with the type-level integer One.-data Dimensionless = Dimensionless-instance Dimension Dimensionless where-  type DimFactorsOf Dimensionless = '[]-type instance DefaultUnitOfDim Dimensionless = Number---- | The unit for unitless dimensioned quantities-data Number = Number -- the unit for unadorned numbers-instance Unit Number where-  type BaseUnit Number = Canonical-  type DimOfUnit Number = Dimensionless-  type UnitFactorsOf Number = '[]- -- | The type of unitless dimensioned quantities. -- This is an instance of @Num@, though Haddock doesn't show it.--- This uses a @Double@ internally and uses a default LCSU.-type Scalar = MkQu_U Number---- | Convert a raw number into a unitless dimensioned quantity-scalar :: n -> Qu '[] l n-scalar = Qu+-- This assumes a default LCSU and an internal representation of @Double@.+type Count = MkQu_U Number
Data/Metrology/Combinators.hs view
@@ -13,7 +13,7 @@  module Data.Metrology.Combinators where -import Data.Singletons ( Sing, SingI, sing )+import Data.Singletons ( SingI, sing )  import Data.Metrology.Dimensions import Data.Metrology.Units@@ -44,6 +44,10 @@ type instance DefaultUnitOfDim (d1 :* d2) =   DefaultUnitOfDim d1 :* DefaultUnitOfDim d2 +instance (Show u1, Show u2) => Show (u1 :* u2) where+  show _ = show (undefined :: u1) ++ " " ++ show (undefined :: u2)++ infixl 7 :/ -- | Divide two units to get another unit data u1 :/ u2 = u1 :/ u2@@ -61,7 +65,11 @@  type instance DefaultUnitOfDim (d1 :/ d2) =   DefaultUnitOfDim d1 :/ DefaultUnitOfDim d2-  ++instance (Show u1, Show u2) => Show (u1 :/ u2) where+  show _ = show (undefined :: u1) ++ "/" ++ show (undefined :: u2)++ infixr 8 :^ -- | Raise a unit to a power, known at compile time data unit :^ (power :: Z) = unit :^ Sing power@@ -79,6 +87,10 @@  type instance DefaultUnitOfDim (d :^ z) = DefaultUnitOfDim d :^ z +instance (Show u1, SingI power) => Show (u1 :^ (power :: Z)) where+  show _ = show (undefined :: u1) ++ "^" ++ show (szToInt (sing :: Sing power))++ infixr 9 :@ -- | Multiply a conversion ratio by some constant. Used for defining prefixes. data prefix :@ unit = prefix :@ unit@@ -95,3 +107,5 @@   type BaseUnit (prefix :@ unit) = unit   conversionRatio _ = multiplier (undefined :: prefix) +instance (Show prefix, Show unit) => Show (prefix :@ unit) where+  show _ = show (undefined :: prefix) ++ show (undefined :: unit)
Data/Metrology/Dimensions.hs view
@@ -16,13 +16,6 @@  import Data.Metrology.Z import Data.Metrology.Factor-import Data.Metrology.LCSU-import Data.Type.Bool-import Data.Type.Equality-import Data.Proxy-import Data.Singletons-import GHC.Exts-  -- | This class is used to mark abstract dimensions, such as @Length@, or -- @Mass@.
Data/Metrology/Factor.hs view
@@ -14,11 +14,11 @@ module Data.Metrology.Factor where  import GHC.Exts (Constraint)-import Data.Metrology.Z+import Data.Metrology.Z as Z import Data.Type.Equality import Data.Type.Bool -import Data.Singletons.Tuple (Fst, Snd)+import Data.Singletons.Prelude  -- | This will only be used at the kind level. It holds a dimension or unit -- with its exponent.@@ -89,6 +89,7 @@ -- @ type family Reorder (a :: [Factor *]) (b :: [Factor *]) :: [Factor *] where   Reorder x x = x+  Reorder '[] x = '[]   Reorder x '[] = x   Reorder x (h ': t) = Reorder' (Extract h x) t @@ -102,7 +103,7 @@ infix 4 @~ -- | Check if two @[Factor *]@s should be considered to be equal type family (a :: [Factor *]) @~ (b :: [Factor *]) :: Constraint where-  a @~ b = (Normalize (Reorder a b) ~ Normalize b)+  a @~ b = (Normalize (a @- b) ~ '[])  ---------------------------------------------------------- --- Normalization ----------------------------------------@@ -125,12 +126,12 @@   '[]                 @@+ b                   = b   a                   @@+ '[]                 = a   ((F name z1) ': t1) @@+ ((F name z2) ': t2) = (F name (z1 #+ z2)) ': (t1 @@+ t2)-  a                   @@+ (h ': t)            = h ': (a @@+ t)+  (h ': t)            @@+ b                   = h ': (t @@+ b)  infixl 6 @+--- | Adds corresponding exponents in two dimension+-- | Adds corresponding exponents in two dimension, preserving order type family (a :: [Factor *]) @+ (b :: [Factor *]) :: [Factor *] where-  a @+ b = (Reorder a b) @@+ b+  a @+ b = a @@+ (Reorder b a)  infixl 6 @@- -- | Subtract exponents in two dimensions, assuming the lists are ordered@@ -139,16 +140,17 @@   '[]                 @@- b                   = NegList b   a                   @@- '[]                 = a   ((F name z1) ': t1) @@- ((F name z2) ': t2) = (F name (z1 #- z2)) ': (t1 @@- t2)-  a                   @@- (h ': t)            = (NegDim h) ': (a @@- t)+  (h ': t)            @@- b                   = h ': (t @@- b)  infixl 6 @- -- | Subtract exponents in two dimensions type family (a :: [Factor *]) @- (b :: [Factor *]) :: [Factor *] where-  a @- b = (Reorder a b) @@- b+  a @- a = '[]+  a @- b = a @@- (Reorder b a)  -- | negate a single @Factor@ type family NegDim (a :: Factor *) :: Factor * where-  NegDim (F n z) = F n (NegZ z)+  NegDim (F n z) = F n (Z.Negate z)  -- | negate a list of @Factor@s type family NegList (a :: [Factor *]) :: [Factor *] where
Data/Metrology/LCSU.hs view
@@ -18,9 +18,6 @@   ) where  import Data.Metrology.Factor-import Data.Metrology.Z--import Data.Singletons.Maybe  data LCSU star = MkLCSU_ [(star, star)]                | DefaultLCSU
+ Data/Metrology/Parser.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE TemplateHaskell, CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.Parser+-- Copyright   :  (C) 2014 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module exports functions allowing users to create their own unit+-- quasiquoters to make for compact unit expressions.+--+-- A typical use case is this:+--+-- > $(makeQuasiQuoter "unit" [''Kilo, ''Milli] [''Meter, ''Second])+--+-- and then, /in a separate module/ (due to GHC's staging constraints)+--+-- > x = 3 % [unit| m/s^2 ]+--+-- The unit expressions can refer to the prefixes and units specified in+-- the call to 'makeQuasiQuoter'. The spellings of the prefixes and units+-- are taken from their @Show@ instances.+--+-- The syntax for these expressions is like+-- F#'s. There are four arithmetic operators (@*@, @/@, @^@, and juxtaposition).+-- Exponentiation binds the tightest, and it allows an integer to its right+-- (possibly with minus signs and parentheses). Next tightest is juxtaposition,+-- which indicates multiplication. Because juxtaposition binds tighter than division,+-- the expressions @m/s^2@ and @m/s s@ are equivalent. Multiplication and+-- division bind the loosest and are left-associative, meaning that @m/s*s@+-- is equivalent to @(m/s)*s@, probably not what you meant. Parentheses in+-- unit expressions are allowed, of course.+--+-- Within a unit string (that is, a unit with an optional prefix), there may+-- be ambiguity. If a unit string can be interpreted as a unit without a+-- prefix, that parsing is preferred. Thus, @min@ would be minutes, not+-- milli-inches (assuming appropriate prefixes and units available.) There still+-- may be ambiguity between unit strings, even interpreting the string as a prefix+-- and a base unit. If a unit string is amiguous in this way, it is rejected.+-- For example, if we have prefixes @da@ and @d@ and units @m@ and @am@, then+-- @dam@ is ambiguous like this.+-----------------------------------------------------------------------------++module Data.Metrology.Parser (+  -- * Quasiquoting interface+  makeQuasiQuoter, allUnits, allPrefixes,++  -- * Direct interface+  +  -- | The definitions below allow users to access the unit parser directly.+  -- The parser produces 'UnitExp's which can then be further processed as+  -- necessary.+  parseUnit,+  UnitExp(..), SymbolTable,+  mkSymbolTable+  ) where++import Prelude hiding ( exp )++import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Language.Haskell.TH.Desugar.Lift  ()  -- get the Lift Name instance+import Data.Maybe+import Control.Monad++import Data.Metrology.Parser.Internal+import Data.Metrology+import Data.Metrology.TH++emptyQQ :: QuasiQuoter+emptyQQ = QuasiQuoter { quoteExp = \_ -> fail "No quasi-quoter for expressions"+                      , quotePat = \_ -> fail "No quasi-quoter for patterns"+                      , quoteType = \_ -> fail "No quasi-quoter for types"+                      , quoteDec = \_ -> fail "No quasi-quoter for declarations" }++errorQQ :: String -> QuasiQuoter+errorQQ msg = QuasiQuoter { quoteExp = \_ -> fail msg+                          , quotePat = \_ -> fail msg+                          , quoteType = \_ -> fail msg+                          , quoteDec = \_ -> fail msg }++-- | @makeQuasiQuoter "qq" prefixes units@ makes a quasi-quoter named @qq@+-- that considers the prefixes and units provided. These are provided via+-- names of the /type/ constructors, /not/ the data constructors. See the+-- module documentation for more info and an example.+makeQuasiQuoter :: String -> [Name] -> [Name] -> Q [Dec]+makeQuasiQuoter qq_name_str prefix_names unit_names = do+  mapM_ checkIsType prefix_names+  mapM_ checkIsType unit_names+  qq <- [| case $sym_tab of+            Left err -> errorQQ err+            Right computed_sym_tab ->+              emptyQQ { quoteExp = \unit_exp ->+                         case parseUnitExp computed_sym_tab unit_exp of+                           Left err2 -> fail err2+                           Right exp -> return exp+                      , quoteType = \unit_exp ->+                         case parseUnitType computed_sym_tab unit_exp of+                           Left err2 -> fail err2+                           Right typ -> return typ+                      } |]+  return [ SigD qq_name (ConT ''QuasiQuoter)+         , ValD (VarP qq_name) (NormalB qq) []]+  where+    qq_name = mkName qq_name_str+    +    mk_pair :: Name -> Q Exp   -- Exp is of type (String, Name)+    mk_pair n = [| (show (undefined :: $( return $ ConT n )), n) |]++    sym_tab :: Q Exp           -- Exp is of type (Either String SymbolTable)+    sym_tab = do+      prefix_pairs <- mapM mk_pair prefix_names+      unit_pairs   <- mapM mk_pair unit_names+      [| mkSymbolTable $( return $ ListE prefix_pairs ) $( return $ ListE unit_pairs ) |]++getInstanceNames :: Name -> Q [Name]+getInstanceNames class_name = do+  ClassI _ insts <- reify class_name+  m_names <- forM insts $ \inst ->+    case inst of+      InstanceD _ ((ConT class_name') `AppT` (ConT unit_name)) []+        |  class_name == class_name'+        -> do show_insts <- reifyInstances ''Show [ConT unit_name]+              case show_insts of+                [_show_inst] -> return $ Just unit_name+                _            -> return Nothing+      _ -> return Nothing+  return $ catMaybes m_names++#if __GLASGOW_HASKELL__ < 709+{-# WARNING allUnits, allPrefixes "Retrieving the list of all units and prefixes in scope does not work under GHC 7.8.*. Please upgrade GHC to use these functions." #-}+#endif++-- | Gets a list of the names of all units with @Show@ instances in scope.+-- Example usage:+--+-- > $( do units <- allUnits+-- >       makeQuasiQuoter "unit" [] units )+--+allUnits :: Q [Name]+allUnits = getInstanceNames ''Unit++-- | Gets a list of the names of all unit prefixes with @Show@ instances in+-- scope. Example usage:+--+-- > $( do units    <- allUnits+-- >       prefixes <- allPrefixes+-- >       makeQuasiQuoter "unit" prefixes units )+--+allPrefixes :: Q [Name]+allPrefixes = getInstanceNames ''UnitPrefix
+ Data/Metrology/Parser/Internal.hs view
@@ -0,0 +1,394 @@+{- units Package+   Copyright (c) 2014 Richard Eisenberg++   This file defines a parser for unit expressions.+-}++{-# LANGUAGE LambdaCase, TemplateHaskell, NoMonomorphismRestriction,+             FlexibleContexts, RankNTypes #-}++module Data.Metrology.Parser.Internal (+  UnitExp(..), parseUnit,+  +  parseUnitExp, parseUnitType, +  SymbolTable(..), mkSymbolTable,+  +  -- only for testing purposes:+  lex, unitStringParser+  ) where++import Prelude hiding ( lex, div )++import Text.Parsec         hiding ( tab )+import Text.Parsec.String+import Text.Parsec.Pos+import qualified Data.Map.Strict as Map+import qualified Data.MultiMap as MM+import Control.Monad.Reader+import Control.Arrow       hiding ( app)+import Data.Maybe+import Data.Char++import Data.Metrology++import Language.Haskell.TH hiding ( Pred )++----------------------------------------------------------------------+-- Basic combinators+----------------------------------------------------------------------++-- copied from GHC+partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])+partitionWith _ [] = ([],[])+partitionWith f (x:xs) = case f x of+                         Left  b -> (b:bs, cs)+                         Right c -> (bs, c:cs)+    where (bs,cs) = partitionWith f xs++----------------------------------------------------------------------+-- Extra parser combinators+----------------------------------------------------------------------++-- | @experiment p@ runs @p@. If @p@ succeeds, @experiment@ returns the+-- result of running @p@. If @p@ fails, then @experiment@ returns @Nothing@.+-- In either case, no input is consumed and @experiment@ never fails.+experiment :: Stream s m t => ParsecT s u m a -> ParsecT s u m (Maybe a)+experiment = lookAhead . optionMaybe . try++consumeAll :: (Stream s m t, Show t) => ParsecT s u m a -> ParsecT s u m a+consumeAll p = do+  result <- p+  eof+  return result++nochar :: Stream s m Char => Char -> ParsecT s u m ()+nochar = void . char++----------------------------------------------------------------------+-- Datatypes+----------------------------------------------------------------------++data Op = NegO | MultO | DivO | PowO | OpenP | CloseP++instance Show Op where+  show NegO    = "-"+  show MultO   = "*"+  show DivO    = "/"+  show PowO    = "^"+  show OpenP   = "("+  show CloseP  = ")"++data Token = UnitT String+           | NumberT Integer+           | OpT Op++instance Show Token where+  show (UnitT s)   = s+  show (NumberT i) = show i+  show (OpT op)    = show op++-- | Parsed unit expressions, parameterized by a prefix identifier type and+-- a unit identifier type+data UnitExp pre u = Unity                     -- ^ "1"+                   | Unit (Maybe pre) u        -- ^ a unit with, perhaps, a prefix+                   | Mult (UnitExp pre u) (UnitExp pre u)+                   | Div (UnitExp pre u) (UnitExp pre u)+                   | Pow (UnitExp pre u) Integer++instance (Show pre, Show u) => Show (UnitExp pre u) where+  show Unity               = "1"+  show (Unit (Just pre) u) = show pre ++ " :@ " ++ show u+  show (Unit Nothing u)    = show u+  show (Mult e1 e2)        = "(" ++ show e1 ++ " :* " ++ show e2 ++ ")"+  show (Div e1 e2)         = "(" ++ show e1 ++ " :/ " ++ show e2 ++ ")"+  show (Pow e i)           = show e ++ " :^ " ++ show i++----------------------------------------------------------------------+-- Lexer+----------------------------------------------------------------------++type Lexer = Parser++unitL :: Lexer Token+unitL = UnitT `fmap` (many1 letter)++opL :: Lexer Token+opL = fmap OpT $+      do { nochar '-'; return NegO    }+  <|> do { nochar '*'; return MultO   }+  <|> do { nochar '/'; return DivO    }+  <|> do { nochar '^'; return PowO    }+  <|> do { nochar '('; return OpenP   }+  <|> do { nochar ')'; return CloseP  }++numberL :: Lexer Token+numberL = (NumberT . read) `fmap` (many1 digit)++lexer1 :: Lexer Token+lexer1 = unitL <|> opL <|> numberL++lexer :: Lexer [Token]+lexer = do+  spaces+  choice+    [ do eof <?> ""+         return []+    , do tok <- lexer1+         spaces+         toks <- lexer+         return (tok : toks)+    ]++lex :: String -> Either ParseError [Token]+lex = parse lexer ""++----------------------------------------------------------------------+-- Symbol tables+----------------------------------------------------------------------++-- | A mapping from prefix spellings to prefix identifiers (of unspecified+-- type @pre@). All prefix spellings must be strictly alphabetic.+type PrefixTable pre = Map.Map String pre++-- | A mapping from unit spellings to unit identifiers (of unspecified type+-- @u@). All unit spellings must be strictly alphabetic.+type UnitTable u = Map.Map String u++-- | A "symbol table" for the parser, mapping prefixes and units to their+-- representations.+data SymbolTable pre u = SymbolTable { prefixTable :: PrefixTable pre+                                     , unitTable   :: UnitTable u+                                     }+  deriving Show++-- build a Map from a list, checking for ambiguity+unambFromList :: (Ord a, Show b) => [(a,b)] -> Either [(a,[String])] (Map.Map a b)+unambFromList list =+  let multimap      = MM.fromList list+      assocs        = MM.assocs multimap+      (errs, goods) = partitionWith (\(key, vals) ->+                                       case vals of+                                         [val] -> Right (key, val)+                                         _     -> Left (key, map show vals)) assocs+      result        = Map.fromList goods+  in+  if null errs then Right result else Left errs++-- | Build a symbol table from prefix mappings and unit mappings. The prefix mapping+-- can be empty. This function checks to make sure that the strings are not+-- inherently ambiguous and are purely alphabetic.+mkSymbolTable :: (Show pre, Show u)+              => [(String, pre)]   -- ^ Association list of prefixes+              -> [(String, u)]     -- ^ Association list of units+              -> Either String (SymbolTable pre u)+mkSymbolTable prefixes units =+  let bad_strings = filter (not . all isLetter) (map fst prefixes ++ map fst units) in+  if not (null bad_strings)+  then Left $ "All prefixes and units must be composed entirely of letters.\nThe following are illegal: " ++ show bad_strings+  else+  let result = do+        prefixTab <- unambFromList prefixes+        unitTab   <- unambFromList units+        return $ SymbolTable { prefixTable = prefixTab, unitTable = unitTab }+  in left ((++ error_suffix) . concatMap mk_error_string) result+  where+    mk_error_string :: Show x => (String, [x]) -> String+    mk_error_string (k, vs) =+      "The label `" ++ k ++ "' is assigned to the following meanings:\n" +++      show vs ++ "\n"+    error_suffix = "This is ambiguous. Please fix before building a unit parser."++----------------------------------------------------------------------+-- Unit string parser+----------------------------------------------------------------------++-- We assume that no symbol table is inherently ambiguous!++type GenUnitStringParser pre u = ParsecT String () (Reader (SymbolTable pre u))+type UnitStringParser_UnitExp =+  forall pre u. (Show pre, Show u) => GenUnitStringParser pre u (UnitExp pre u)++-- parses just a unit (no prefix)+justUnitP :: GenUnitStringParser pre u u+justUnitP = do+  full_string <- getInput+  units <- asks unitTable+  case Map.lookup full_string units of+    Nothing -> fail (full_string ++ " does not match any known unit")+    Just u  -> return u++-- parses a unit and prefix, failing in the case of ambiguity+prefixUnitP :: UnitStringParser_UnitExp+prefixUnitP = do+  prefixTab <- asks prefixTable+  let assocs = Map.assocs prefixTab  -- these are in the right order+  results <- catMaybes `liftM` mapM (experiment . parse_one) assocs+  full_string <- getInput+  case results of+    [] -> fail $ "No known interpretation for " ++ full_string+    [(pre_name, unit_name)] ->+      return $ Unit (Just pre_name) unit_name+    lots -> fail $ "Multiple possible interpretations for " ++ full_string ++ ":\n" +++                   (concatMap (\(pre_name, unit_name) ->+                                 "  " ++ show pre_name +++                                 " :@ " ++ show unit_name ++ "\n") lots)+  where+    parse_one :: (String, pre) -> GenUnitStringParser pre u (pre, u)+    parse_one (pre, name) = do+      void $ string pre+      unit_name <- justUnitP+      return (name, unit_name)++-- parse a unit string+unitStringParser :: UnitStringParser_UnitExp+unitStringParser = try (Unit Nothing `liftM` justUnitP) <|> prefixUnitP++----------------------------------------------------------------------+-- Unit expression parser+----------------------------------------------------------------------++type GenUnitParser pre u = ParsecT [Token] () (Reader (SymbolTable pre u))+type UnitParser a = forall pre u. GenUnitParser pre u a+type UnitParser_UnitExp =+  forall pre u. (Show pre, Show u) => GenUnitParser pre u (UnitExp pre u)++-- move a source position past a token+updatePosToken :: SourcePos -> Token -> [Token] -> SourcePos+updatePosToken pos (UnitT unit_str) _ = updatePosString pos unit_str+updatePosToken pos (NumberT i) _      = updatePosString pos (show i)+updatePosToken pos (OpT _) _          = incSourceColumn pos 1++-- parse a Token+uToken :: (Token -> Maybe a) -> UnitParser a+uToken = tokenPrim show updatePosToken++-- consume an lparen+lparenP :: UnitParser ()+lparenP = uToken $ \case+  OpT OpenP -> Just ()+  _         -> Nothing++-- consume an rparen+rparenP :: UnitParser ()+rparenP = uToken $ \case+  OpT CloseP -> Just ()+  _          -> Nothing++-- parse a unit string+unitStringP :: String -> UnitParser_UnitExp+unitStringP str = do+  symbolTable <- ask+  case flip runReader symbolTable $ runParserT unitStringParser () "" str of+    Left err -> fail (show err)+    Right e  -> return e++-- parse a number, possibly negated and nested in parens+numP :: UnitParser Integer+numP =+  do lparenP+     n <- numP+     rparenP+     return n+  <|>+  do uToken $ \case+       OpT NegO -> Just ()+       _        -> Nothing+     negate `liftM` numP+  <|>+  do uToken $ \case+       NumberT i -> Just i+       _         -> Nothing++-- parse an exponentiation, like "^2"+powP :: GenUnitParser pre u (UnitExp pre u -> UnitExp pre u)+powP = option id $ do+  uToken $ \case+    OpT PowO -> Just ()+    _        -> Nothing+  n <- numP+  return $ flip Pow n++-- parse a unit, possibly with an exponent+unitP :: UnitParser_UnitExp+unitP =+  do n <- numP+     case n of+       1 -> return Unity+       _ -> unexpected $ "number " ++ show n+  <|>+  do unit_str <- uToken $ \case+       UnitT unit_str -> Just unit_str+       _              -> Nothing+     u <- unitStringP unit_str+     maybe_pow <- powP+     return $ maybe_pow u++-- parse a "unit factor": either a juxtaposed sequence of units+-- or a paranthesized unit exp.+unitFactorP :: UnitParser_UnitExp+unitFactorP =+  do lparenP+     unitExp <- parser+     rparenP+     return unitExp+  <|>+  (foldl1 Mult `liftM` many1 unitP)++-- parse * or /+opP :: GenUnitParser pre u (UnitExp pre u -> UnitExp pre u -> UnitExp pre u)+opP = uToken $ \case+        OpT MultO -> Just Mult+        OpT DivO  -> Just Div+        _         -> Nothing++-- parse a whole unit expression+parser :: UnitParser_UnitExp+parser = chainl unitFactorP opP Unity++-- | Parse a unit expression, interpreted with respect the given symbol table.+-- Returns either an error message or the successfully-parsed unit expression.+parseUnit :: (Show pre, Show u)+          => SymbolTable pre u -> String -> Either String (UnitExp pre u)+parseUnit tab s = left show $ do+  toks <- lex s+  flip runReader tab $ runParserT (consumeAll parser) () "" toks++----------------------------------------------------------------------+-- TH conversions+----------------------------------------------------------------------++parseUnitExp :: SymbolTable Name Name -> String -> Either String Exp+parseUnitExp tab s = to_exp `liftM` parseUnit tab s   -- the Either monad+  where+    to_exp Unity                  = ConE 'Number+    to_exp (Unit (Just pre) unit) = ConE '(:@) `AppE` of_type pre `AppE` of_type unit+    to_exp (Unit Nothing unit)    = of_type unit+    to_exp (Mult e1 e2)           = ConE '(:*) `AppE` to_exp e1 `AppE` to_exp e2+    to_exp (Div e1 e2)            = ConE '(:/) `AppE` to_exp e1 `AppE` to_exp e2+    to_exp (Pow e i)              = ConE '(:^) `AppE` to_exp e `AppE` mk_sing i++    of_type :: Name -> Exp+    of_type n = (VarE 'undefined) `SigE` (ConT n)++    mk_sing :: Integer -> Exp+    mk_sing n+      | n < 0     = VarE 'sPred `AppE` mk_sing (n + 1)+      | n > 0     = VarE 'sSucc `AppE` mk_sing (n - 1)+      | otherwise = VarE 'sZero++parseUnitType :: SymbolTable Name Name -> String -> Either String Type+parseUnitType tab s = to_type `liftM` parseUnit tab s   -- the Either monad+  where+    to_type Unity                  = ConT ''Number+    to_type (Unit (Just pre) unit) = ConT ''(:@) `AppT` ConT pre `AppT` ConT unit+    to_type (Unit Nothing unit)    = ConT unit+    to_type (Mult e1 e2)           = ConT ''(:*) `AppT` to_type e1 `AppT` to_type e2+    to_type (Div e1 e2)            = ConT ''(:/) `AppT` to_type e1 `AppT` to_type e2+    to_type (Pow e i)              = ConT ''(:^) `AppT` to_type e `AppT` mk_z i++    mk_z :: Integer -> Type+    mk_z n+      | n < 0     = ConT ''Pred `AppT` mk_z (n + 1)+      | n > 0     = ConT ''Succ `AppT` mk_z (n - 1)+      | otherwise = ConT 'Zero   -- single quote as it's a data constructor!+
+ Data/Metrology/Poly.hs view
@@ -0,0 +1,242 @@+{- Data/Metrology/Poly.hs++   The units Package+   Copyright (c) 2013 Richard Eisenberg+   eir@cis.upenn.edu++   This file gathers and exports all user-visible pieces of the units package.+   It also defines the main creators and consumers of dimensioned objects.+-}++{-# LANGUAGE ExplicitNamespaces, DataKinds, FlexibleInstances, TypeFamilies,+             TypeOperators, ConstraintKinds, ScopedTypeVariables,+             FlexibleContexts, UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.Poly+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module exports all the gubbins needed for type-checking your+-- dimensioned quantities. See 'Data.Metrology' for some functions+-- restricted to using a default LCSU, which is suitable for many+-- applications. See also 'Data.Metrology.Vector' for polymorphic+-- functions suitable for use with the numerical classes from the+-- @vector-space@ package.+-----------------------------------------------------------------------------++module Data.Metrology.Poly (+  -- * Term-level combinators++  -- | The term-level arithmetic operators are defined by+  -- applying vertical bar(s) to the sides the dimensioned +  -- quantities acts on.++  -- ** Additive operations+  zero, (|+|), (|-|), qSum, qNegate,++  -- ** Multiplicative operations between quantities+  (|*|), (|/|),++  -- ** Multiplicative operations between a quantity and a non-quantity+  (*|), (|*), (/|), (|/),++  -- ** Exponentiation+  (|^), (|^^), qNthRoot,+  qSq, qCube, qSqrt, qCubeRoot,++  -- ** Comparison+  qCompare, (|<|), (|>|), (|<=|), (|>=|), (|==|), (|/=|),+  qApprox, qNapprox,        ++  -- * Nondimensional units, conversion between quantities and numeric values+  numIn, (#), quOf, (%), showIn,+  unity, redim, convert,+  defaultLCSU, constant, ++  -- * Type-level unit combinators+  (:*)(..), (:/)(..), (:^)(..), (:@)(..),+  UnitPrefix(..),++  -- * Type-level quantity combinators+  type (%*), type (%/), type (%^),++  -- * Creating quantity types+  Qu, MkQu_D, MkQu_DLN, MkQu_U, MkQu_ULN, ++  -- * Creating new dimensions+  Dimension,++  -- * Creating new units+  Unit(type BaseUnit, type DimOfUnit, conversionRatio), +  Canonical,++  -- * Numbers, the only built-in unit+  Dimensionless(..), Number(..), Count, quantity,++  -- * LCSUs (locally coherent system of units)+  MkLCSU, LCSU(DefaultLCSU), DefaultUnitOfDim,++  -- * Validity checks and assertions+  CompatibleUnit, CompatibleDim, ConvertibleLCSUs_D,+  DefaultConvertibleLCSU_D, DefaultConvertibleLCSU_U,+  MultDimFactors, MultUnitFactors, UnitOfDimFactors,++  -- * Type-level integers+  Z(..), Succ, Pred, type (#+), type (#-), type (#*), type (#/), Negate,++  -- ** Synonyms for small numbers+  One, Two, Three, Four, Five, MOne, MTwo, MThree, MFour, MFive,++  -- ** Term-level singletons+  sZero, sOne, sTwo, sThree, sFour, sFive,+  sMOne, sMTwo, sMThree, sMFour, sMFive,+  sSucc, sPred, sNegate,++  -- ** Deprecated synonyms for the ones above+  pZero, pOne, pTwo, pThree, pFour, pFive,+  pMOne, pMTwo, pMThree, pMFour, pMFive,+  pSucc, pPred,++  -- * Internal definitions+  -- | The following module is re-exported solely to prevent noise in error messages;+  -- we do not recommend trying to use these definitions in user code.+  module Data.Metrology.Internal++  ) where++import Data.Metrology.Z+import Data.Metrology.Qu+import Data.Metrology.Dimensions+import Data.Metrology.Factor+import Data.Metrology.Units+import Data.Metrology.Combinators+import Data.Metrology.LCSU+import Data.Metrology.Validity+import Data.Metrology.Internal++import Data.Foldable as F+import Data.Proxy++-- | Extracts a numerical value from a dimensioned quantity, expressed in+--   the given unit. For example:+--+--   > inMeters :: Length -> Double+--   > inMeters x = numIn x Meter+--+--   or+--+--   > inMeters x = x # Meter   +numIn :: forall unit dim lcsu n.+         ( ValidDLU dim lcsu unit+         , Fractional n ) +      => Qu dim lcsu n -> unit -> n+numIn (Qu val) u+  = val * fromRational+             (canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu))+              / canonicalConvRatio u)++infix 5 #+-- | Infix synonym for 'numIn'+(#) :: ( ValidDLU dim lcsu unit+       , Fractional n )+    => Qu dim lcsu n -> unit -> n+(#) = numIn++-- | Creates a dimensioned quantity in the given unit. For example:+--+--   > height :: Length+--   > height = quOf 2.0 Meter+--+--   or+--+--   > height = 2.0 % Meter+quOf :: forall unit dim lcsu n.+         ( ValidDLU dim lcsu unit+         , Fractional n )+      => n -> unit -> Qu dim lcsu n+quOf d u+  = Qu (d * fromRational+               (canonicalConvRatio u+                / canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu))))++infixr 9 %+-- | Infix synonym for 'quOf'+(%) :: ( ValidDLU dim lcsu unit+       , Fractional n )+    => n -> unit -> Qu dim lcsu n+(%) = quOf++infix 1 `showIn`+-- | Show a dimensioned quantity in a given unit. (The default @Show@+-- instance always uses units as specified in the LCSU.)+showIn :: ( ValidDLU dim lcsu unit+          , Fractional n+          , Show unit+          , Show n )+       => Qu dim lcsu n -> unit -> String+showIn x u = show (x # u) ++ " " ++ show u++-- | Dimension-keeping cast between different CSUs.+convert :: forall d l1 l2 n. +  ( ConvertibleLCSUs d l1 l2+  , Fractional n )+  => Qu d l1 n -> Qu d l2 n+convert (Qu x) = Qu $ x * fromRational (+  canonicalConvRatioSpec (Proxy :: Proxy (LookupList d l1))+  / canonicalConvRatioSpec (Proxy :: Proxy (LookupList d l2)))++-- | Compute the argument in the @DefaultLCSU@, and present the result as+-- lcsu-polymorphic dimension-polymorphic value. Named 'constant' because one+-- of its dominant usecase is to inject constant quantities into+-- dimension-polymorphic expressions.+constant :: ( d @~ e+            , ConvertibleLCSUs e DefaultLCSU l+            , Fractional n )+         => Qu d DefaultLCSU n -> Qu e l n+constant = convert . redim++----------------------------------------------------+-- Qu operations+----------------------------------------------------++-- | The number 0, polymorphic in its dimension. Use of this will+-- often require a type annotation.+zero :: Num n => Qu dimspec l n+zero = Qu 0++infixl 6 |+|+-- | Add two compatible quantities+(|+|) :: (d1 @~ d2, Num n) => Qu d1 l n -> Qu d2 l n -> Qu d1 l n+(Qu a) |+| (Qu b) = Qu (a + b)++infixl 6 |-|+-- | Subtract two compatible quantities+(|-|) :: (d1 @~ d2, Num n) => Qu d1 l n -> Qu d2 l n -> Qu d1 l n+a |-| b = a |+| qNegate b++-- | Take the sum of a list of quantities+qSum :: (Foldable f, Num n) => f (Qu d l n) -> Qu d l n+qSum = F.foldr (|+|) zero++-- | Negate a quantity+qNegate :: Num n => Qu d l n -> Qu d l n+qNegate (Qu x) = Qu (negate x)++infixl 7 *| , |* , |/+-- | Multiply a quantity by a scalar from the left+(*|) :: Num n => n -> Qu b l n -> Qu (Normalize b) l n+a *| (Qu b) = Qu (a * b)++-- | Multiply a quantity by a scalar from the right+(|*) :: Num n => Qu a l n -> n -> Qu (Normalize a) l n+(Qu a) |* b = Qu (a * b)++-- | Divide a quantity by a scalar+(|/) :: Fractional n => Qu a l n -> n -> Qu (Normalize a) l n+(Qu a) |/ b = Qu (a / b)+
+ Data/Metrology/Qu.hs view
@@ -0,0 +1,264 @@+{- Data/Metrology/Qu.hs++   The units Package+   Copyright (c) 2013 Richard Eisenberg+   eir@cis.upenn.edu++   This file defines the 'Qu' type that represents quantity+   (a number paired with its measurement reference).+   This file also defines operations on 'Qu's that are shared between+   the vector and non-vector interfaces.+-}++{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, UndecidableInstances,+             ConstraintKinds, StandaloneDeriving, GeneralizedNewtypeDeriving,+             FlexibleInstances, RoleAnnotations, FlexibleContexts #-}++module Data.Metrology.Qu where++import Data.Metrology.Dimensions+import Data.Metrology.Factor+import Data.Metrology.Units+import Data.Metrology.Z+import Data.Metrology.LCSU++-------------------------------------------------------------+--- Internal ------------------------------------------------+-------------------------------------------------------------++-- | 'Qu' adds a dimensional annotation to its numerical value type+-- @n@. This is the representation for all quantities.+newtype Qu (a :: [Factor *]) (lcsu :: LCSU *) (n :: *) = Qu n+type role Qu nominal nominal representational++-------------------------------------------------------------+--- User-facing ---------------------------------------------+-------------------------------------------------------------++-- Abbreviation for creating a Qu (defined here to avoid a module cycle)++-- | Make a quantity type capable of storing a value of a given+-- unit. This uses a 'Double' for storage of the value. For example:+--+-- > data LengthDim = LengthDim+-- > instance Dimension LengthDim+-- > data Meter = Meter+-- > instance Unit Meter where+-- >   type BaseUnit Meter = Canonical+-- >   type DimOfUnit Meter = LengthDim+-- > type instance DefaultUnitOfDim LengthDim = Meter+-- > type Length = MkQu_D LengthDim+--+-- Note that the dimension /must/ have an instance for the type family+-- 'DefaultUnitOfDim' for this to work.+type MkQu_D dim = Qu (DimFactorsOf dim) DefaultLCSU Double++-- | Make a quantity type with a custom numerical type and LCSU.+type MkQu_DLN dim = Qu (DimFactorsOf dim)++-- | Make a quantity type with a given unit. It will be stored as a 'Double'.+-- Note that the corresponding dimension /must/ have an appropriate instance+-- for 'DefaultUnitOfDim' for this to work.+type MkQu_U unit = Qu (DimFactorsOf (DimOfUnit unit)) DefaultLCSU Double++-- | Make a quantity type with a unit and LCSU with custom numerical type.+--   The quantity will have the dimension corresponding to the unit.+type MkQu_ULN unit = Qu (DimFactorsOf (DimOfUnit unit))++---------------------------------------+---------------------------------------+-- Privileged operations+---------------------------------------+---------------------------------------++---------------------------------------+-- Quantities of dimension one+---------------------------------------++-- | Convert a raw number into a unitless dimensioned quantity+quantity :: n -> Qu '[] l n+quantity = Qu++---------------------------------------+-- Multiplicative operations+---------------------------------------++infixl 7 |*|+-- | Multiply two quantities+(|*|) :: Num n => Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n+(Qu a) |*| (Qu b) = Qu (a * b)++infixl 7 |/|+-- | Divide two quantities+(|/|) :: Fractional n => Qu a l n -> Qu b l n -> Qu (Normalize (a @- b)) l n+(Qu a) |/| (Qu b) = Qu (a / b)++---------------------------------------+-- Exponentiation+---------------------------------------++-- The following are privileged for efficiency.++infixr 8 |^+-- | Raise a quantity to a integer power, knowing at compile time that the integer is non-negative.+(|^) :: (NonNegative z, Num n) => Qu a l n -> Sing z -> Qu (a @* z) l n+(Qu a) |^ sz = Qu (a ^ szToInt sz)++infixr 8 |^^+-- | Raise a quantity to a integer power known at compile time+(|^^) :: Fractional n => Qu a l n -> Sing z -> Qu (a @* z) l n+(Qu a) |^^ sz = Qu (a ^^ szToInt sz)++-- | Take the n'th root of a quantity, where n is known at compile+-- time+qNthRoot :: ((Zero < z) ~ True, Floating n)+        => Sing z -> Qu a l n -> Qu (a @/ z) l n+qNthRoot sz (Qu a) = Qu (a ** (1.0 / (fromIntegral $ szToInt sz)))++---------------------------------------+-- Comparison+---------------------------------------++-- | Compare two quantities+qCompare :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Ordering+qCompare (Qu a) (Qu b) = compare a b++infix 4 |<|+-- | Check if one quantity is less than a compatible one+(|<|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool+(Qu a) |<| (Qu b) = a < b++infix 4 |>|+-- | Check if one quantity is greater than a compatible one+(|>|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool+(Qu a) |>| (Qu b) = a > b++infix 4 |<=|+-- | Check if one quantity is less than or equal to a compatible one+(|<=|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool+(Qu a) |<=| (Qu b) = a <= b++infix 4 |>=|+-- | Check if one quantity is greater than or equal to a compatible one+(|>=|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool+(Qu a) |>=| (Qu b) = a >= b++infix 4 |==|+-- | Check if two quantities are equal (uses the equality of the underlying numerical type)+(|==|) :: (d1 @~ d2, Eq n) => Qu d1 l n -> Qu d2 l n -> Bool+(Qu a) |==| (Qu b) = a == b++infix 4 |/=|+-- | Check if two quantities are not equal+(|/=|) :: (d1 @~ d2, Eq n) => Qu d1 l n -> Qu d2 l n -> Bool+(Qu a) |/=| (Qu b) = a /= b++infix 4 `qApprox` , `qNapprox`+-- | Compare two compatible quantities for approximate equality. If the+-- difference between the left hand side and the right hand side arguments are+-- less than or equal to the /epsilon/, they are considered equal.+qApprox :: (d0 @~ d1, d0 @~ d2, Num n, Ord n)+      => Qu d0 l n  -- ^ /epsilon/+      -> Qu d1 l n  -- ^ left hand side+      -> Qu d2 l n  -- ^ right hand side+      -> Bool  +qApprox (Qu epsilon) (Qu a) (Qu b) = abs(a-b) <= epsilon++-- | Compare two compatible quantities for approixmate inequality.  +-- @qNapprox e a b = not $ qApprox e a b@+qNapprox :: (d0 @~ d1, d0 @~ d2, Num n, Ord n)+       => Qu d0 l n  -- ^ /epsilon/      +       -> Qu d1 l n  -- ^ left hand side +       -> Qu d2 l n  -- ^ right hand side+       -> Bool+qNapprox (Qu epsilon) (Qu a) (Qu b) = abs(a-b) > epsilon++---------------------------------------+---------------------------------------+-- Unprivileged operations+---------------------------------------+---------------------------------------++infixl 7 /|+-- | Divide a scalar by a quantity+(/|) :: Fractional n => n -> Qu b l n -> Qu (Normalize ('[] @- b)) l n+a /| b = quantity a |/| b++-- | Square a quantity+qSq :: Num n => Qu a l n -> Qu (Normalize (a @+ a)) l n+qSq x = x |*| x++-- | Cube a quantity+qCube :: Num n => Qu a l n -> Qu (Normalize (Normalize (a @+ a) @+ a)) l n+qCube x = x |*| x |*| x++-- | Take the square root of a quantity+qSqrt :: Floating n => Qu a l n -> Qu (a @/ Two) l n+qSqrt = qNthRoot sTwo++-- | Take the cubic root of a quantity+qCubeRoot :: Floating n => Qu a l n -> Qu (a @/ Three) l n+qCubeRoot = qNthRoot sThree++-------------------------------------------------------------+--- Instances for all quantities ----------------------------+-------------------------------------------------------------++deriving instance Eq n => Eq (Qu d l n)+deriving instance Ord n => Ord (Qu d l n)++-------------------------------------------------------------+--- Instances for dimensionless quantities ------------------+-------------------------------------------------------------++deriving instance Num n => Num (Qu '[] l n)+deriving instance Real n => Real (Qu '[] l n)+deriving instance Fractional n => Fractional (Qu '[] l n)+deriving instance Floating n => Floating (Qu '[] l n)+deriving instance RealFrac n => RealFrac (Qu '[] l n)+deriving instance RealFloat n => RealFloat (Qu '[] l n)++-------------------------------------------------------------+--- Combinators ---------------------------------------------+-------------------------------------------------------------++infixl 7 %*+-- | Multiply two quantity types to produce a new one. For example:+--+-- > type Velocity = Length %/ Time+type family (d1 :: *) %* (d2 :: *) :: *+type instance (Qu d1 l n) %* (Qu d2 l n) = Qu (d1 @+ d2) l n++infixl 7 %/+-- | Divide two quantity types to produce a new one+type family (d1 :: *) %/ (d2 :: *) :: *+type instance (Qu d1 l n) %/ (Qu d2 l n) = Qu (d1 @- d2) l n++infixr 8 %^+-- | Exponentiate a quantity type to an integer+type family (d :: *) %^ (z :: Z) :: *+type instance (Qu d l n) %^ z = Qu (d @* z) l n++-------------------------------------------------------------+--- Term-level combinators ----------------------------------+-------------------------------------------------------------++-- | Use this to choose a default LCSU for a dimensioned quantity.+-- The default LCSU uses the 'DefaultUnitOfDim' representation for each+-- dimension.+defaultLCSU :: Qu dim DefaultLCSU n -> Qu dim DefaultLCSU n+defaultLCSU = id++-- | The number 1, expressed as a unitless dimensioned quantity.+unity :: Num n => Qu '[] l n+unity = Qu 1++-- | Cast between equivalent dimension within the same CSU.+--  for example [kg m s] and [s m kg]. See the README for more info.+redim :: (d @~ e) => Qu d l n -> Qu e l n+redim (Qu x) = Qu x++-- | The type of unitless dimensioned quantities.+-- This is an instance of @Num@, though Haddock doesn't show it.+-- This is parameterized by an LCSU and a number representation.+type Count = MkQu_ULN Number
Data/Metrology/Quantity.hs view
@@ -1,223 +1,55 @@-{- Data/Metrology.Quantity.hs--   The units Package-   Copyright (c) 2013 Richard Eisenberg-   eir@cis.upenn.edu--   This file defines the 'Qu' type that represents quantity-   (a number paired with its measurement reference).-   This file also defines operations on 'Qu' types.--}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.Quantity+-- Copyright   :  (C) 2014 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Exports a class 'Quantity' to allow easy conversion between proper+-- quantities and types from other libraries.+------------------------------------------------------------------------------ -{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, UndecidableInstances,-             ConstraintKinds, StandaloneDeriving, GeneralizedNewtypeDeriving,-             FlexibleInstances, RoleAnnotations #-}+{-# LANGUAGE DataKinds, TypeFamilies, ConstraintKinds, UndecidableInstances #-}  module Data.Metrology.Quantity where -import Data.Singletons ( Sing )-import Data.Metrology.Dimensions-import Data.Metrology.Factor-import Data.Metrology.Units-import Data.Metrology.Z-import Data.Metrology.LCSU------------------------------------------------------------------- Internal ------------------------------------------------------------------------------------------------------------------ | 'Qu' adds a dimensional annotation to its numerical value type--- @n@. This is the representation for all quantities.-newtype Qu (a :: [Factor *]) (lcsu :: LCSU *) (n :: *) = Qu n-type role Qu nominal nominal representational------------------------------------------------------------------- User-facing --------------------------------------------------------------------------------------------------------------- Abbreviation for creating a Qu (defined here to avoid a module cycle)+import Data.Metrology.Poly --- | Make a quantity type capable of storing a value of a given--- unit. This uses a 'Double' for storage of the value. For example:+-- | 'Quantity' allows for easy conversions in and out of quantities. For example,+-- say you are working with an outside library for time that defines `UTCTime`, where+-- that stores the time measured in seconds. You could say ----- > data LengthDim = LengthDim--- > instance Dimension LengthDim--- > data Meter = Meter--- > instance Unit Meter where--- >   type BaseUnit Meter = Canonical--- >   type DimOfUnit Meter = LengthDim--- > type instance DefaultUnitOfDim LengthDim = Meter--- > type Length = MkQu_D LengthDim+-- > instance Quantity UTCTime where+-- >   type QuantityUnit = Second+-- >   fromQuantity = ...+-- >   toQuantity = ... ----- Note that the dimension /must/ have an instance for the type family--- 'DefaultUnitOfDim' for this to work.-type MkQu_D dim = Qu (DimFactorsOf dim) DefaultLCSU Double---- | Make a quantity type with a custom numerical type and LCSU.-type MkQu_DLN dim = Qu (DimFactorsOf dim)---- | Make a quantity type with a given unit. It will be stored as a 'Double'.--- Note that the corresponding dimension /must/ have an appropriate instance--- for 'DefaultUnitOfDim' for this to work.-type MkQu_U unit = Qu (DimFactorsOf (DimOfUnit unit)) DefaultLCSU Double---- | Make a quantity type with a unit and LCSU with custom numerical type.---   The quantity will have the dimension corresponding to the unit.-type MkQu_ULN unit = Qu (DimFactorsOf (DimOfUnit unit))---infixl 6 |+|--- | Add two compatible quantities-(|+|) :: (d1 @~ d2, Num n) => Qu d1 l n -> Qu d2 l n -> Qu d1 l n-(Qu a) |+| (Qu b) = Qu (a + b)--infixl 6 |-|--- | Subtract two compatible quantities-(|-|) :: (d1 @~ d2, Num n) => Qu d1 l n -> Qu d2 l n -> Qu d1 l n-(Qu a) |-| (Qu b) = Qu (a - b)--infixl 7 |*|--- | Multiply two quantities-(|*|) :: Num n => Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n-(Qu a) |*| (Qu b) = Qu (a * b)--infixl 7 |/|--- | Divide two quantities-(|/|) :: Fractional n => Qu a l n -> Qu b l n -> Qu (Normalize (a @- b)) l n-(Qu a) |/| (Qu b) = Qu (a / b)--infixl 7 *| , |* , /| , |/--- | Multiply a quantity by a scalar from the left-(*|) :: Num n => n -> Qu b l n -> Qu b l n-a *| (Qu b) = Qu (a * b)---- | Multiply a quantity by a scalar from the right-(|*) :: Num n => Qu a l n -> n -> Qu a l n-(Qu a) |* b = Qu (a * b)---- | Divide a scalar by a quantity-(/|) :: Fractional n => n -> Qu b l n -> Qu (NegList b) l n-a /| (Qu b) = Qu (a / b)---- | Divide a quantity by a scalar-(|/) :: Fractional n => Qu a l n -> n -> Qu a l n-(Qu a) |/ b = Qu (a / b)--infixr 8 |^--- | Raise a quantity to a integer power, knowing at compile time that the integer is non-negative.-(|^) :: Fractional n => Qu a l n -> Sing z -> Qu (a @* z) l n -- TODO: type level proof here-(Qu a) |^ sz = Qu (a ^ szToInt sz)--infixr 8 |^^--- | Raise a quantity to a integer power known at compile time-(|^^) :: Fractional n => Qu a l n -> Sing z -> Qu (a @* z) l n-(Qu a) |^^ sz = Qu (a ^^ szToInt sz)---- | Take the n'th root of a quantity, where n is known at compile--- time-nthRoot :: ((Zero < z) ~ True, Floating n)-        => Sing z -> Qu a l n -> Qu (a @/ z) l n-nthRoot sz (Qu a) = Qu (a ** (1.0 / (fromIntegral $ szToInt sz)))--infix 4 |<|--- | Check if one quantity is less than a compatible one-(|<|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool-(Qu a) |<| (Qu b) = a < b--infix 4 |>|--- | Check if one quantity is greater than a compatible one-(|>|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool-(Qu a) |>| (Qu b) = a > b--infix 4 |<=|--- | Check if one quantity is less than or equal to a compatible one-(|<=|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool-(Qu a) |<=| (Qu b) = a <= b--infix 4 |>=|--- | Check if one quantity is greater than or equal to a compatible one-(|>=|) :: (d1 @~ d2, Ord n) => Qu d1 l n -> Qu d2 l n -> Bool-(Qu a) |>=| (Qu b) = a >= b--infix 4 |==|--- | Check if two quantities are equal (uses the equality of the underlying numerical type)-(|==|) :: (d1 @~ d2, Eq n) => Qu d1 l n -> Qu d2 l n -> Bool-(Qu a) |==| (Qu b) = a == b--infix 4 |/=|--- | Check if two quantities are not equal-(|/=|) :: (d1 @~ d2, Eq n) => Qu d1 l n -> Qu d2 l n -> Bool-(Qu a) |/=| (Qu b) = a /= b--infix 4 `qApprox` , `qNapprox`--- | Compare two compatible quantities for approximate equality.  If--- the difference between the left hand side and the right hand side--- arguments are less than the /epsilon/, they are considered equal.-qApprox :: (d0 @~ d1, d0 @~ d2, Num n, Ord n)-      => Qu d0 l n  -- ^ /epsilon/-      -> Qu d1 l n  -- ^ left hand side-      -> Qu d2 l n  -- ^ right hand side-      -> Bool  -qApprox (Qu epsilon) (Qu a) (Qu b) = abs(a-b) < epsilon---- | Compare two compatible quantities for approixmate inequality.  --- @qNapprox e a b = not $ qApprox e a b@-qNapprox :: (d0 @~ d1, d0 @~ d2, Num n, Ord n)-       => Qu d0 l n  -- ^ /epsilon/      -       -> Qu d1 l n  -- ^ left hand side -       -> Qu d2 l n  -- ^ right hand side-       -> Bool-qNapprox (Qu epsilon) (Qu a) (Qu b) = abs(a-b) >= epsilon---- | Square a quantity-qSq :: Num n => Qu a l n -> Qu (Normalize (a @+ a)) l n-qSq x = x |*| x---- | Cube a quantity-qCube :: Num n => Qu a l n -> Qu (Normalize (Normalize (a @+ a) @+ a)) l n-qCube x = x |*| x |*| x---- | Take the square root of a quantity-qSqrt :: Floating n => Qu a l n -> Qu (a @/ Two) l n-qSqrt = nthRoot pTwo---- | Take the cubic root of a quantity-qCubeRoot :: Floating n => Qu a l n -> Qu (a @/ Three) l n-qCubeRoot = nthRoot pThree-------------------------------------------------------------------- Instances for dimensionless quantities ----------------------------------------------------------------------------------deriving instance Eq n => Eq (Qu '[] l n)-deriving instance Ord n => Ord (Qu '[] l n)-deriving instance Num n => Num (Qu '[] l n)-deriving instance Real n => Real (Qu '[] l n)-deriving instance Fractional n => Fractional (Qu '[] l n)-deriving instance Floating n => Floating (Qu '[] l n)-deriving instance RealFrac n => RealFrac (Qu '[] l n)-deriving instance RealFloat n => RealFloat (Qu '[] l n)+-- Then, conversions are easy and unit-safe.+class Quantity t where+  -- | The unit associated with @t@.+  type QuantityUnit t :: * ------------------------------------------------------------------ Combinators -----------------------------------------------------------------------------------------------------------+  -- | The LCSU associated with @t@. Defaults to 'DefaultLCSU'.+  type QuantityLCSU t :: LCSU *+  type QuantityLCSU t = DefaultLCSU -infixl 7 %*--- | Multiply two quantity types to produce a new one. For example:------ > type Velocity = Length %/ Time-type family (d1 :: *) %* (d2 :: *) :: *-type instance (Qu d1 l n) %* (Qu d2 l n) = Qu (d1 @+ d2) l n+  -- | The numerical representation associated with @t@. Defaults to 'Double'.+  type QuantityRep t :: *+  type QuantityRep t = Double -infixl 7 %/--- | Divide two quantity types to produce a new one-type family (d1 :: *) %/ (d2 :: *) :: *-type instance (Qu d1 l n) %/ (Qu d2 l n) = Qu (d1 @- d2) l n+  fromQuantity :: QuantityQu t -> t+  toQuantity :: t -> QuantityQu t -infixr 8 %^--- | Exponentiate a quantity type to an integer-type family (d :: *) %^ (z :: Z) :: *-type instance (Qu d l n) %^ z = Qu (d @* z) l n+-- | The 'Qu' type associated with a member of the 'Quantity' class+type QuantityQu t = MkQu_ULN (QuantityUnit t) (QuantityLCSU t) (QuantityRep t) +instance ValidDL d l =>+         Quantity (Qu d l n) where+  type QuantityUnit (Qu d l n) = UnitOfDimFactors d l+  type QuantityLCSU (Qu d l n) = l+  type QuantityRep  (Qu d l n) = n +  fromQuantity = id+  toQuantity = id
Data/Metrology/Show.hs view
@@ -12,23 +12,20 @@ -- Portability :  non-portable -- -- This module defines 'Show' instance for quantities. The show instance--- prints out the number stored internally with its canonical units. To print+-- prints out the number stored internally with its correct units. To print -- out quantities with specific units use the function `showIn`. ----------------------------------------------------------------------------- -module Data.Metrology.Show (showIn) where+module Data.Metrology.Show () where  import Data.Proxy (Proxy(..)) import Data.List-import Data.Singletons (Sing, sing, SingI)+import Data.Singletons (sing, SingI)  import Data.Metrology.Factor-import Data.Metrology.Quantity+import Data.Metrology.Qu import Data.Metrology.Z import Data.Metrology.LCSU-import Data.Metrology.Combinators-import Data.Metrology.Units-import Data.Metrology  class ShowUnitFactor (dims :: [Factor *]) where   showDims :: Bool   -- take absolute value of exponents?@@ -58,7 +55,7 @@     case (length nums, length denoms) of       (0, 0) -> ""       (_, 0) -> " " ++ nums-      (0, _) -> build_string (snd (showDims False p))+      (0, _) -> " " ++ build_string (snd (showDims False p))       (_, _) -> " " ++ nums ++ "/" ++ denoms   where     mapPair :: (a -> b) -> (a, a) -> (b, b)@@ -74,32 +71,8 @@     build_string_helper [s] = s     build_string_helper (h:t) = h ++ " * " ++ build_string_helper t --- enable showing of compound units:-instance (Show u1, Show u2) => Show (u1 :* u2) where-  show _ = show (undefined :: u1) ++ " " ++ show (undefined :: u2)--instance (Show u1, Show u2) => Show (u1 :/ u2) where-  show _ = show (undefined :: u1) ++ "/" ++ show (undefined :: u2)--instance (Show u1, SingI power) => Show (u1 :^ (power :: Z)) where-  show _ = show (undefined :: u1) ++ "^" ++ show (szToInt (sing :: Sing power))---- enable showing of units with prefixes:-instance (Show prefix, Show unit) => Show (prefix :@ unit) where-  show _ = show (undefined :: prefix) ++ show (undefined :: unit)- instance (ShowUnitFactor (LookupList dims lcsu), Show n)            => Show (Qu dims lcsu n) where   show (Qu d) = show d ++-                (' ' : showFactor (Proxy :: Proxy (LookupList dims lcsu)))--infix 1 `showIn`+                (showFactor (Proxy :: Proxy (LookupList dims lcsu))) --- | Show a dimensioned quantity in a given unit. (The default @Show@--- instance always uses canonical units.)-showIn :: ( ValidDLU dim lcsu unit-          , Fractional n-          , Show unit-          , Show n )-       => Qu dim lcsu n -> unit -> String-showIn x u = show (x # u) ++ " " ++ show u
+ Data/Metrology/TH.hs view
@@ -0,0 +1,175 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.TH+-- Copyright   :  (C) 2014 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module exports Template Haskell functions to make working with+-- @units@ a little more convenient.+-----------------------------------------------------------------------------++{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_HADDOCK prune #-}++module Data.Metrology.TH (+  evalType,+  declareDimension, declareCanonicalUnit, declareDerivedUnit, declareMonoUnit,++  -- for internal use only+  checkIsType                                    +  ) where++import Language.Haskell.TH+import Language.Haskell.TH.Desugar+import Language.Haskell.TH.Desugar.Expand+import Language.Haskell.TH.Desugar.Lift ()   -- need Lift Rational++import Data.Metrology.Dimensions+import Data.Metrology.Units+import Data.Metrology.LCSU++-- | "Evaluates" a type as far as it can. This is useful, say, in instance+-- declarations:+--+-- > instance Show $(evalType [t| Length |]) where ...+--+-- Without the 'evalType', the instance declaration fails because @Length@+-- mentions type families, which can't be used in instance declarations.+--+-- This function is somewhat experimental, and will likely not work with+-- more polymorphic types. (If it doesn't work, not all of the type families+-- will be evaluated, and the instance declaration will fail. This function+-- should never cause /incorrect/ behavior.)+evalType :: Q Type -> Q Type+evalType qty = do+  ty <- qty+  dty <- dsType ty+  ex_dty <- expandType dty+  return $ sweeten ex_dty++-- Checks to make sure the given name names a /type/, not a /data constructor/.+-- Reports a compile-time error if the name is not a type.+checkIsType :: Name -> Q ()+checkIsType n = do+  info <- reify n+  case info of+    ClassOpI {} -> generic_error+    DataConI {} -> datacon_error+    VarI {} -> generic_error+    _ -> return ()+  where+    generic_error = reportError $ "The name " ++ show n ++ " does not describe a type.\n    A type is expected here."+    datacon_error = reportError $ "The name " ++ show n ++ " describes a data constructor.\n    Did you perhaps mean to say ''" ++ nameBase n ++ "? Note the two quotes."++-- | Declare a new dimension of the given name:+--+-- > $(declareDimension "Length")+--+-- produces+--+-- > data Length = Length+-- > instance Dimension Length+declareDimension :: String -> Q [Dec]+declareDimension str =+  return [ DataD [] name [] [NormalC name []] []+         , InstanceD [] (ConT ''Dimension `AppT` ConT name) [] ]+  where+    name = mkName str++-- | Conditionally generates a @Show@ instance+maybeMkShowInstance :: Name -> Maybe String -> Q [Dec]+maybeMkShowInstance name (Just abbrev) =+  [d| instance Show $(return $ ConT name) where { show _ = abbrev } |]+maybeMkShowInstance _ Nothing = return []++-- | @declareCanonicalUnit unit_name dim (Just abbrev)@ creates a new+-- canonical unit (that is, it is not defined in terms of other known units)+-- named @unit_name@, measuring dimension @dim@. (@dim@ must be the name of+-- the dimension /type/, not /data constructor/.) @abbrev@ will be the+-- abbreviation in the unit's @Show@ instance. If no abbraviation is supplied,+-- then no @Show@ instance will be generated.+--+-- Example usage:+--+-- > $(declareCanonicalUnit "Meter" ''Length (Just "m"))+declareCanonicalUnit :: String -> Name -> Maybe String -> Q [Dec]+declareCanonicalUnit unit_name_str dim m_abbrev = do+  checkIsType dim+  show_instance <- maybeMkShowInstance unit_name m_abbrev+  unit_instance <- [d| instance Unit $unit_type where+                         type BaseUnit $unit_type = Canonical+                         type DimOfUnit $unit_type = $dim_type |]+  return $ (DataD [] unit_name [] [NormalC unit_name []] [])+           : unit_instance ++ show_instance+  where+    unit_name = mkName unit_name_str+    unit_type = return $ ConT unit_name+    dim_type = return $ ConT dim++-- | @declareDerivedUnit unit_name base_unit_type ratio (Just abbrev)@ creates+-- a new derived unit, expressed in terms of @base_unit_type@ (which must be the+-- name of a /type/ not a /data constructor/). @ratio@ says how many base units+-- are in the derived unit. (Thus, if @unit_name@ is @"Minute"@ and @base_unit_type@+-- is @''Second@, then @ratio@ would be @60@.) @abbrev@, if supplied, becomes+-- the string produced in the derived unit's @Show@ instance. If no abbreviation+-- is supplied, no @Show@ instance is generated.+--+-- Example usage:+--+-- > $(declareDerivedUnit "Minute" ''Second 60 (Just "min"))+declareDerivedUnit :: String -> Name -> Rational -> Maybe String -> Q [Dec]+declareDerivedUnit unit_name_str base_unit ratio m_abbrev = do+  checkIsType base_unit+  show_instance <- maybeMkShowInstance unit_name m_abbrev+  unit_instance <- [d| instance Unit $unit_type where+                         type BaseUnit $unit_type = $base_unit_type+                         conversionRatio _ = ratio |]+  return $ (DataD [] unit_name [] [NormalC unit_name []] [])+           : unit_instance ++ show_instance+  where+    unit_name = mkName unit_name_str+    unit_type = return $ ConT unit_name+    base_unit_type = return $ ConT base_unit++-- | @declareMonoUnit unit_name (Just abbrev)@ creates a new derived unit,+-- intended for use without unit polymorphism. The same type stands for both+-- the unit and dimension, and the instance of 'DefaultUnitOfDim' is set up+-- accordingly. Use this function (with the 'Data.Metrology' imports) if you+-- don't want to bother with LCSUs and just want to get to work. The @abbrev@,+-- if supplied, creates an appropriate @Show@ instance.+--+-- > $(declareMonoUnit "Meter" (Just "m"))+--+-- produces all of the following+--+-- > data Meter = Meter+-- > instance Dimension Meter+-- > instance Unit Meter where+-- >   type BaseUnit Meter = Canonical+-- >   type DimOfUnit Meter = Meter+-- > type instance DefaultUnitOfDim Meter = Meter+-- > instance Show Meter where+-- >   show _ = "m"+--+-- After a declaration like this, you probably want+--+-- > type Length = MkQu_U Meter+--+-- This last line is /not/ generated, as it is easy enough for you to write,+-- and it involves a new name (@Length@).+declareMonoUnit :: String -> Maybe String -> Q [Dec]+declareMonoUnit unit_name_str m_abbrev = do+  show_instance <- maybeMkShowInstance unit_name m_abbrev+  dim_instance <- [d| instance Dimension $unit_type |]+  unit_instance <- [d| instance Unit $unit_type where+                         type BaseUnit $unit_type = Canonical+                         type DimOfUnit $unit_type = $unit_type |]+  default_instance <- [d| type instance DefaultUnitOfDim $unit_type = $unit_type |]+  return $ (DataD [] unit_name [] [NormalC unit_name []] [])+           : show_instance ++ dim_instance ++ unit_instance ++ default_instance+  where+    unit_name = mkName unit_name_str+    unit_type = return $ ConT unit_name
Data/Metrology/Units.hs view
@@ -140,3 +140,22 @@   canonicalConvRatioSpec _ =     (canonicalConvRatio (undefined :: unit) ^^ szToInt (sing :: Sing n)) *     canonicalConvRatioSpec (Proxy :: Proxy rest)++-------------------------------------------------------------+--- "Number" unit -------------------------------------------+-------------------------------------------------------------++-- | The dimension for the dimensionless quantities.+-- It is also called "quantities of dimension one", but+-- @One@ is confusing with the type-level integer One.+data Dimensionless = Dimensionless+instance Dimension Dimensionless where+  type DimFactorsOf Dimensionless = '[]+type instance DefaultUnitOfDim Dimensionless = Number++-- | The unit for unitless dimensioned quantities+data Number = Number -- the unit for unadorned numbers+instance Unit Number where+  type BaseUnit Number = Canonical+  type DimOfUnit Number = Dimensionless+  type UnitFactorsOf Number = '[]
Data/Metrology/Unsafe.hs view
@@ -19,5 +19,5 @@   Qu(..),   ) where -import Data.Metrology.Quantity+import Data.Metrology.Qu
Data/Metrology/Validity.hs view
@@ -17,8 +17,31 @@ import Data.Metrology.Dimensions import Data.Metrology.Units import Data.Metrology.Set+import Data.Metrology.Combinators import GHC.Exts ( Constraint ) +------------------------------------------------+-- Helper functions+------------------------------------------------++-- | Extract a dimension specifier from a list of factors+type family MultDimFactors (facts :: [Factor *]) where+  MultDimFactors '[] = Dimensionless+  MultDimFactors (F d z ': ds) = (d :^ z) :* MultDimFactors ds++-- | Extract a unit specifier from a list of factors+type family MultUnitFactors (facts :: [Factor *]) where+  MultUnitFactors '[] = Number+  MultUnitFactors (F unit z ': units) = (unit :^ z) :* MultUnitFactors units+  +-- | Extract a unit from a dimension factor list and an LCSU+type family UnitOfDimFactors (dims :: [Factor *]) (lcsu :: LCSU *) :: * where+  UnitOfDimFactors dims lcsu = MultUnitFactors (LookupList dims lcsu)++------------------------------------------------+-- Main validity functions+------------------------------------------------+ -- | Check if a (dimension factors, LCSU, unit) triple are all valid to be used together. type family ValidDLU (dfactors :: [Factor *]) (lcsu :: LCSU *) (unit :: *) where   ValidDLU dfactors lcsu unit =@@ -30,8 +53,7 @@ -- | Check if a (dimension factors, LCSU) pair are valid to be used together. This -- checks that each dimension maps to a unit of the correct dimension. type family ValidDL (dfactors :: [Factor *]) (lcsu :: LCSU *) :: Constraint where-  ValidDL '[] lcsu             = (() :: Constraint)-  ValidDL (F d z ': rest) lcsu = (DimOfUnit (Lookup d lcsu) ~ d, ValidDL rest lcsu)+  ValidDL dfactors lcsu = ValidDLU dfactors lcsu (UnitOfDimFactors dfactors lcsu)  -- | Are two LCSUs inter-convertible at the given dimension? type family ConvertibleLCSUs (dfactors :: [Factor *])
+ Data/Metrology/Vector.hs view
@@ -0,0 +1,344 @@+{-# LANGUAGE TypeOperators, FlexibleContexts, DataKinds, TypeFamilies,+             ScopedTypeVariables, ConstraintKinds, GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.Vector+-- Copyright   :  (C) 2014 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Exports combinators for building quantities out of vectors, from the+-- vector-space library.+------------------------------------------------------------------------------++module Data.Metrology.Vector (+  -- * Term-level combinators++  -- | The term-level arithmetic operators are defined by+  -- applying vertical bar(s) to the sides the dimensioned +  -- quantities acts on.++  -- ** Additive operations+  zero, (|+|), (|-|), qSum, qNegate,++  -- ** Multiplicative operations between non-vector quantities+  (|*|), (|/|), (/|),++  -- ** Multiplicative operations between a vector and a scalar+  (*|), (|*), (|/),++  -- ** Multiplicative operations on vectors+  (|*^|), (|^*|), (|^/|), (|.|),+  +  -- ** Exponentiation+  (|^), (|^^), qNthRoot,+  qSq, qCube, qSqrt, qCubeRoot,++  -- ** Other vector operations+  qMagnitudeSq, qMagnitude, qNormalized, qProject, qCross2, qCross3,++  -- ** Affine operations+  Point(..), QPoint, (|.-.|), (|.+^|), (|.-^|), qDistanceSq, qDistance,+  +  -- ** Comparison+  qCompare, (|<|), (|>|), (|<=|), (|>=|), (|==|), (|/=|),+  qApprox, qNapprox,        ++  -- * Nondimensional units, conversion between quantities and numeric values+  numIn, (#), quOf, (%), showIn,+  unity, redim, convert,+  defaultLCSU, constant, ++  -- * Type-level unit combinators+  (:*)(..), (:/)(..), (:^)(..), (:@)(..),+  UnitPrefix(..),++  -- * Type-level quantity combinators+  type (%*), type (%/), type (%^),++  -- * Creating quantity types+  Qu, MkQu_D, MkQu_DLN, MkQu_U, MkQu_ULN, ++  -- * Creating new dimensions+  Dimension,++  -- * Creating new units+  Unit(type BaseUnit, type DimOfUnit, conversionRatio), +  Canonical,++  -- * Numbers, the only built-in unit+  Dimensionless(..), Number(..), Count, quantity,++  -- * LCSUs (locally coherent system of units)+  MkLCSU, LCSU(DefaultLCSU), DefaultUnitOfDim,++  -- * Validity checks and assertions+  CompatibleUnit, CompatibleDim, ConvertibleLCSUs_D,+  DefaultConvertibleLCSU_D, DefaultConvertibleLCSU_U,+  MultDimFactors, MultUnitFactors, UnitOfDimFactors,++  -- * Type-level integers+  Z(..), Succ, Pred, type (#+), type (#-), type (#*), type (#/), Negate,++  -- ** Synonyms for small numbers+  One, Two, Three, Four, Five, MOne, MTwo, MThree, MFour, MFive,++  -- ** Term-level singletons+  sZero, sOne, sTwo, sThree, sFour, sFive,+  sMOne, sMTwo, sMThree, sMFour, sMFive,+  sSucc, sPred, sNegate,++  -- * Internal definitions+  -- | The following module is re-exported solely to prevent noise in error messages;+  -- we do not recommend trying to use these definitions in user code.+  module Data.Metrology.Internal++  ) where++import Data.Metrology.Qu+import Data.Metrology.LCSU+import Data.Metrology.Validity+import Data.Metrology.Factor+import Data.Metrology.Z as Z+import Data.Metrology.Units+import Data.Metrology.Combinators+import Data.Metrology.Dimensions+import Data.Metrology.Internal++import Data.AffineSpace+import Data.VectorSpace+import Data.Cross hiding ( One, Two, Three )++import Data.Proxy+import Data.Coerce+import Data.Foldable as F++---------------------------------------+-- Additive operations+---------------------------------------++-- | The number 0, polymorphic in its dimension. Use of this will+-- often require a type annotation.+zero :: AdditiveGroup n => Qu dimspec l n+zero = Qu zeroV++infixl 6 |+|+-- | Add two compatible quantities+(|+|) :: (d1 @~ d2, AdditiveGroup n) => Qu d1 l n -> Qu d2 l n -> Qu d1 l n+(Qu a) |+| (Qu b) = Qu (a ^+^ b)++-- | Negate a quantity+qNegate :: AdditiveGroup n => Qu d l n -> Qu d l n+qNegate (Qu x) = Qu (negateV x)++infixl 6 |-|+-- | Subtract two compatible quantities+(|-|) :: (d1 @~ d2, AdditiveGroup n) => Qu d1 l n -> Qu d2 l n -> Qu d1 l n+a |-| b = a |+| qNegate b++-- | Take the sum of a list of quantities+qSum :: (Foldable f, AdditiveGroup n) => f (Qu d l n) -> Qu d l n+qSum = F.foldr (|+|) zero++---------------------------------------+-- Vector multiplicative operations+---------------------------------------++infixl 7 |*^|, |^*|, |^/|+-- | Multiply a scalar quantity by a vector quantity+(|*^|) :: VectorSpace n => Qu d1 l (Scalar n) -> Qu d2 l n -> Qu (Normalize (d1 @+ d2)) l n+(Qu a) |*^| (Qu b) = Qu (a *^ b)++-- | Multiply a vector quantity by a scalar quantity+(|^*|) :: VectorSpace n => Qu d1 l n -> Qu d2 l (Scalar n) -> Qu (Normalize (d1 @+ d2)) l n+(Qu a) |^*| (Qu b) = Qu (a ^* b)++-- | Divide a vector quantity by a scalar quantity+(|^/|) :: (VectorSpace n, Fractional (Scalar n))+       => Qu d1 l n -> Qu d2 l (Scalar n) -> Qu (Normalize (d1 @- d2)) l n+(Qu a) |^/| (Qu b) = Qu (a ^/ b)++infixl 7 |/+-- | Divide a quantity by a scalar+(|/) :: (VectorSpace n, Fractional (Scalar n)) => Qu a l n -> Scalar n -> Qu (Normalize a) l n+(Qu a) |/ b = Qu (a ^/ b)+-- The above function should *not* need to be privileged. But, GHC can't figure+-- out that a @@- '[] ~ a. Urgh.++infixl 7 *| , |*+-- | Multiply a quantity by a scalar from the left+(*|) :: VectorSpace n => Scalar n -> Qu b l n -> Qu (Normalize b) l n+a *| b = quantity a |*^| b++-- | Multiply a quantity by a scalar from the right+(|*) :: VectorSpace n => Qu a l n -> Scalar n -> Qu (Normalize a) l n+a |* b = a |^*| quantity b++---------------------------------------+-- Multiplicative operations+---------------------------------------++infixl 7 |.|+-- | Take a inner (dot) product between two quantities.+(|.|) :: InnerSpace n => Qu d1 l n -> Qu d2 l n -> Qu (Normalize (d1 @+ d2)) l (Scalar n)+(Qu a) |.| (Qu b) = Qu (a <.> b)++-- | Square the length of a vector.+qMagnitudeSq :: InnerSpace n => Qu d l n -> Qu (d @* Z.Two) l (Scalar n)+qMagnitudeSq (Qu x) = Qu (magnitudeSq x)++-- | Length of a vector.+qMagnitude :: (InnerSpace n, Floating (Scalar n)) => Qu d l n -> Qu d l (Scalar n)+qMagnitude (Qu x) = Qu (magnitude x)++-- | Vector in same direction as given one but with length of one. If given the zero+-- vector, then return it. The returned vector is dimensionless.+qNormalized :: (InnerSpace n, Floating (Scalar n)) => Qu d l n -> Qu '[] l n+qNormalized (Qu x) = Qu (normalized x)++-- | @qProject u v@ computes the projection of @v@ onto @u@.+qProject :: (InnerSpace n, Floating (Scalar n)) => Qu d2 l n -> Qu d1 l n -> Qu d1 l n+qProject (Qu u) (Qu v) = Qu (u `project` v)++-- | Cross product of 2D vectors.+qCross2 :: HasCross2 n => Qu d l n -> Qu d l n+qCross2 (Qu x) = Qu (cross2 x)++-- | Cross product of 3D vectors.+qCross3 :: HasCross3 n => Qu d1 l n -> Qu d2 l n -> Qu (Normalize (d1 @+ d2)) l n+qCross3 (Qu x) (Qu y) = Qu (x `cross3` y)++---------------------------------------+-- Affine space operations+---------------------------------------++-- | A @Point n@ is an affine space built over @n@. Two @Point@s cannot be added,+-- but they can be subtracted to yield a difference of type @n@.+newtype Point n = Point n+  deriving (Show, Eq, Enum, Bounded)++-- | Make a point quantity from a non-point quantity.+type family QPoint n where+  QPoint (Qu d l n) = Qu d l (Point n)++instance AdditiveGroup n => AffineSpace (Point n) where+  type Diff (Point n) = n+  (.-.) = coerce ((^-^) :: n -> n -> n)+  (.+^) = coerce ((^+^) :: n -> n -> n)++infixl 6 |.-.|, |.+^|, |.-^|++-- | Subtract point quantities.+(|.-.|) :: (d1 @~ d2, AffineSpace n) => Qu d1 l n -> Qu d2 l n -> Qu d1 l (Diff n)+(Qu a) |.-.| (Qu b) = Qu (a .-. b)++-- | Add a point to a vector.+(|.+^|) :: (d1 @~ d2, AffineSpace n) => Qu d1 l n -> Qu d2 l (Diff n) -> Qu d1 l n+(Qu a) |.+^| (Qu b) = Qu (a .+^ b)++-- | Subract a vector from a point.+(|.-^|) :: (d1 @~ d2, AffineSpace n) => Qu d1 l n -> Qu d2 l (Diff n) -> Qu d1 l n+(Qu a) |.-^| (Qu b) = Qu (a .-^ b)++-- | Square of the distance between two points.+qDistanceSq :: (d1 @~ d2, AffineSpace n, InnerSpace (Diff n))+            => Qu d1 l n -> Qu d2 l n -> Qu (d1 @* Z.Two) l (Scalar (Diff n))+qDistanceSq (Qu a) (Qu b) = Qu (a `distanceSq` b)++-- | Distance between two points.+qDistance :: (d1 @~ d2, AffineSpace n, InnerSpace (Diff n), Floating (Scalar (Diff n)))+          => Qu d1 l n -> Qu d2 l n -> Qu d1 l (Scalar (Diff n))+qDistance (Qu a) (Qu b) = Qu (a `distance` b)++---------------------------------------+-- Top-level operations+---------------------------------------++-- | Extracts a numerical value from a dimensioned quantity, expressed in+--   the given unit. For example:+--+--   > inMeters :: Length -> Double+--   > inMeters x = numIn x Meter+--+--   or+--+--   > inMeters x = x # Meter   +numIn :: forall unit dim lcsu n.+         ( ValidDLU dim lcsu unit+         , VectorSpace n+         , Fractional (Scalar n) )+      => Qu dim lcsu n -> unit -> n+numIn (Qu val) u+  = val ^* fromRational+             (canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu))+              / canonicalConvRatio u)++infix 5 #+-- | Infix synonym for 'numIn'+(#) :: ( ValidDLU dim lcsu unit+       , VectorSpace n+       , Fractional (Scalar n) )+    => Qu dim lcsu n -> unit -> n+(#) = numIn++-- | Creates a dimensioned quantity in the given unit. For example:+--+--   > height :: Length+--   > height = quOf 2.0 Meter+--+--   or+--+--   > height = 2.0 % Meter+quOf :: forall unit dim lcsu n.+         ( ValidDLU dim lcsu unit+         , VectorSpace n+         , Fractional (Scalar n) )+      => n -> unit -> Qu dim lcsu n+quOf d u+  = Qu (d ^* fromRational+               (canonicalConvRatio u+                / canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu))))++infixr 9 %+-- | Infix synonym for 'quOf'+(%) :: ( ValidDLU dim lcsu unit+       , VectorSpace n+       , Fractional (Scalar n) )+    => n -> unit -> Qu dim lcsu n+(%) = quOf++-- | Dimension-keeping cast between different CSUs.+convert :: forall d l1 l2 n. +  ( ConvertibleLCSUs d l1 l2+  , VectorSpace n+  , Fractional (Scalar n) ) +  => Qu d l1 n -> Qu d l2 n+convert (Qu x) = Qu $ x ^* fromRational (+  canonicalConvRatioSpec (Proxy :: Proxy (LookupList d l1))+  / canonicalConvRatioSpec (Proxy :: Proxy (LookupList d l2)))+++-- | Compute the argument in the @DefaultLCSU@, and present the result as+-- lcsu-polymorphic dimension-polymorphic value. Named 'constant' because one+-- of its dominant usecase is to inject constant quantities into+-- dimension-polymorphic expressions.+constant :: ( d @~ e+            , ConvertibleLCSUs e DefaultLCSU l+            , VectorSpace n+            , Fractional (Scalar n) )+         => Qu d DefaultLCSU n -> Qu e l n+constant = convert . redim++infix 1 `showIn`+-- | Show a dimensioned quantity in a given unit. (The default @Show@+-- instance always uses units as specified in the LCSU.)+showIn :: ( ValidDLU dim lcsu unit+          , VectorSpace n+          , Fractional (Scalar n)+          , Show unit+          , Show n )+       => Qu dim lcsu n -> unit -> String+showIn x u = show (x # u) ++ " " ++ show u
Data/Metrology/Z.hs view
@@ -10,7 +10,7 @@  {-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, UndecidableInstances,              GADTs, PolyKinds, TemplateHaskell, ScopedTypeVariables,-             EmptyCase #-}+             EmptyCase, CPP #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}  -----------------------------------------------------------------------------@@ -29,9 +29,42 @@ -- know. ----------------------------------------------------------------------------- -module Data.Metrology.Z where+-- allow compilation even without Cabal+#ifndef MIN_VERSION_singletons+#define MIN_VERSION_singletons(a,b,c) 1+#endif +module Data.Metrology.Z (+  -- * The 'Z' datatype+  Z(..), Sing(..), SZ,++#if MIN_VERSION_singletons(1,0,0)+  -- ** Defunctionalization symbols (these can be ignored)+  ZeroSym0, SSym0, SSym1, PSym0, PSym1,+#endif++  -- * Conversions+  zToInt, szToInt,++  -- * Type-level operations+  -- ** Arithmetic+  Succ, Pred, Negate, type (#+), type (#-), type (#*), type (#/),+  sSucc, sPred, sNegate,++  -- ** Comparisons+  type (<), NonNegative,++  -- * Synonyms for certain numbers+  One, Two, Three, Four, Five, MOne, MTwo, MThree, MFour, MFive,+  sZero, sOne, sTwo, sThree, sFour, sFive, sMOne, sMTwo, sMThree, sMFour, sMFive,++  -- * Deprecated synonyms+  pZero, pOne, pTwo, pThree, pFour, pFive, pMOne, pMTwo, pMThree, pMFour, pMFive,+  pSucc, pPred+  ) where+ import Data.Singletons.TH+import GHC.Exts ( Constraint )  -- | The datatype for type-level integers. $(singletons [d| data Z = Zero | S Z | P Z deriving Eq |])@@ -84,15 +117,15 @@   (P z1) #* z2 = (z1 #* z2) #- z2  -- | Negate an integer-type family NegZ (z :: Z) :: Z where-  NegZ Zero = Zero-  NegZ (S z) = P (NegZ z)-  NegZ (P z) = S (NegZ z)+type family Negate (z :: Z) :: Z where+  Negate Zero = Zero+  Negate (S z) = P (Negate z)+  Negate (P z) = S (Negate z)  -- | Divide two integers type family (a :: Z) #/ (b :: Z) :: Z where   Zero #/ b      = Zero-  a    #/ (P b') = NegZ (a #/ (NegZ (P b')))+  a    #/ (P b') = Negate (a #/ (Negate (P b')))   a    #/ b      = ZDiv b b a  -- | Helper function for division@@ -114,6 +147,11 @@   (P n) < (S n') = True   (P n) < (P n') = n < n' +-- | Check if a type-level integer is in fact a natural number+type family NonNegative z :: Constraint where+  NonNegative Zero  = ()+  NonNegative (S z) = ()+ type One   = S Zero type Two   = S One type Three = S Two@@ -128,31 +166,56 @@  -- | This is the singleton value representing @Zero@ at the term level and -- at the type level, simultaneously. Used for raising units to powers.-pZero  = SZero-pOne   = SS pZero-pTwo   = SS pOne-pThree = SS pTwo-pFour  = SS pThree-pFive  = SS pFour+sZero  = SZero+sOne   = SS sZero+sTwo   = SS sOne+sThree = SS sTwo+sFour  = SS sThree+sFive  = SS sFour -pMOne   = SP pZero-pMTwo   = SP pMOne-pMThree = SP pMTwo-pMFour  = SP pMThree-pMFive  = SP pMFour+sMOne   = SP sZero+sMTwo   = SP sMOne+sMThree = SP sMTwo+sMFour  = SP sMThree+sMFive  = SP sMFour  -- | Add one to a singleton @Z@.-pSucc :: Sing z -> Sing (Succ z)-pSucc SZero   = pOne-pSucc (SS z') = SS (SS z')-pSucc (SP z') = z'+sSucc :: Sing z -> Sing (Succ z)+sSucc SZero   = sOne+sSucc (SS z') = SS (SS z')+sSucc (SP z') = z'  -- | Subtract one from a singleton @Z@.-pPred :: Sing z -> Sing (Pred z)-pPred SZero   = pMOne-pPred (SS z') = z'-pPred (SP z') = SP (SP z')+sPred :: Sing z -> Sing (Pred z)+sPred SZero   = sMOne+sPred (SS z') = z'+sPred (SP z') = SP (SP z') +-- | Negate a singleton @Z@.+sNegate :: Sing z -> Sing (Negate z)+sNegate SZero = SZero+sNegate (SS z') = SP (sNegate z')+sNegate (SP z') = SS (sNegate z')+ -- | Convert a singleton @Z@ to an @Int@. szToInt :: Sing (z :: Z) -> Int szToInt = zToInt . fromSing++{-# DEPRECATED pZero, pOne, pTwo, pThree, pFour, pFive, pMOne, pMTwo, pMThree, pMFour, pMFive, pSucc, pPred "The singleton prefix is changing from 'p' to 's'. The 'p' versions will be removed in a future release." #-}++pZero  = sZero+pOne   = sOne+pTwo   = sTwo+pThree = sThree+pFour  = sFour+pFive  = sFive++pMOne   = sMOne+pMTwo   = sMTwo+pMThree = sMThree+pMFour  = sMFour+pMFive  = sMFive++pSucc = sSucc+pPred = sPred+
README.md view
@@ -3,16 +3,22 @@  The _units_ package provides a mechanism for compile-time dimensional analysis in Haskell programs. It defines an embedded type system based on-units-of-measure. The units defined are fully extensible, and need not relate-to physical properties. As a matter of convenience only, the core package-defines the dimensions and units for the international system (SI), and you-can find many additional units and dimensions in package _units-extra_.+units-of-measure. The units and dimensions defined are fully extensible, and+need not relate to physical properties. This package exports definitions+only for `Dimensionless` and `Number`. The set of units and dimensions from+the International System (SI) are exported from the companion package `units-defs`. -The package supports defining multiple inter-convertible units, such-as `Meter` and `Foot`. When extracting a numerical value from a quantity,-the desired unit must be specified, and the value is converted into-that unit.+This package supports independent notions of _dimension_ and _unit_. Examples+of dimensions include length and mass. Examples of unit include meter and+gram. Every unit measures a particular dimension, but a given dimension+may be measure by many different units. For example, both meters and feet+measure length. +The package supports defining multiple inter-convertible units of the same+dimension, such as `Meter` and `Foot`. When extracting a numerical value from+a quantity, the desired unit must be specified, and the value is converted+into that unit.+ The laws of nature have dimensions, and they hold true regardless of the units used. For example, the gravitational force between two bodies is `(gravitational constant) * (mass 1) * (mass 2) / (distance between body 1 and@@ -21,16 +27,14 @@  The _units_ package supports unit-polymorphic programs through the coherent system of units (CSU) mechanism. A CSU is essentially a mapping from-dimensions (such as length or mass) to the units (such as meters or-kilograms). All dimensioned quantities (generally just called quantities) are-expressed using the `Qu` type. The `Qu` type constructor takes a (perhaps-compound) dimension, a CSU and a numerical value type as arguments.+dimensions to the units. All dimensioned quantities (generally just called+quantities) are expressed using the `Qu` type. The `Qu` type constructor takes+a (perhaps compound) dimension, a CSU and a numerical value type as arguments. Internally, the quantity is stored as a number in the units as specified in-the CSU -- this may matter if you are worried about rounding errors.-In the sequence of computations that works within one CSU,-there is no unit conversion. Unit conversions are needed only when-putting values in and out of quantities, or converting between two different-CSUs.+the CSU -- this may matter if you are worried about rounding errors. In the+sequence of computations that works within one CSU, there is no unit+conversion. Unit conversions are needed only when putting values in and out of+quantities, or converting between two different CSUs.   @@ -48,18 +52,35 @@ Modules ------- -The _units_ package exports several modules. For any given project, you will-include some set of these modules. There are dependency relationships-between them. Of course, you're welcome to `import` a module without its-dependents, but it probably won't be very useful to you. I hope that this list-grows over time.+The _units_ package exports several key modules. Note that you will generally+import only *one* of `Data.Metrology`, `Data.Metrology.Poly`, or+`Data.Metrology.Vector`. - -  __`Data.Metrology`__+ -  __`Data.Metrology.Poly`__      This is the main exported module. It exports all the necessary functionality-    for you to build your own set of units and operate with them. All modules-    implicitly depend on this one.+    for you to build your own set of units and operate with them. + -  __`Data.Metrology`__++    This re-exports most of the definitions from `Data.Metrology.Poly`, but+    restricts a few operators to work only with the default LCSU, as this is+    simpler for new users to `units`.++ -  __`Data.Metrology.Vector`__++    This also re-exports a similar set of definitions as `Data.Metrology.Poly`,+    but provides numerical operations based on `vector-space` instead of the+    standard numerical classes.++ -  __`Data.Metrology.Internal`__++    This module contains mostly-internal definitions that may appear in GHC's+    error messages. Users will generally not need to use these definitions in+    their code. However, by exporting this module from within+    `Data.Metrology.Poly`, we can reduce the module-prefix clutter in error+    messages.+  -  __`Data.Metrology.Unsafe`__      This module exports the constructor for the central datatype that stores@@ -71,46 +92,69 @@     This module defines a `Show` instance for quantities, printing     out the number stored along with its canonical dimension. This behavior     may not be the best for every setting, so it is exported separately.+    Importing this module reduces the guaranteed unit-safety of your code,+    because it allows you to inspect (in a round-about way) how your quantities+    are stored. - -  __`Data.Metrology.SI`__+ -  __`Data.Metrology.Parser`__ -    This module exports unit definitions for the [SI][] system of units,-    re-exporting the three modules below.+    This module allows users to create custom unit parsers. The user specifies+    a set of prefixes and a set of units to parse, and then a quasi-quoting parser+    is generated. See the module documentation for details. -[SI]: http://en.wikipedia.org/wiki/International_System_of_Units- - -  __`Data.Metrology.SI.Units`__+ -  __`Data.Metrology.TH`__ -    This module exports only the SI units, such as `Meter` and `Ampere`.+    This module exports several functions, written with Template Haskell, that+    make programming with `units` somewhat easier. In particular, see+    `declareMonoUnit`, which gets rid of a lot of the boilerplate if you don't+    want unit polymorphism. - -  __`Data.Metrology.SI.Types`__+ -  __`Data.Metrology.Quantity`__ -    This module exports pre-defined unit type synonyms for SI dimensions,-    convenient for use with the SI.Units module.-    For example, `Length` is the type of-    quantities with unit `Meter`s and with numerical type `Double`.+    This module defines a `Quantity` class to enable easy, safe conversions with+    non-`units` types. See the module for more documentation. - -  __`Data.Metrology.SI.Prefixes`__+Examples+======== -    This module exports the SI prefixes. Note that this does *not* depend on-    any of the other SI modules -- you can use these prefixes with any system-    of units.+We will build up a full working example in several sections. It is awkward to+explain the details of the pieces until the whole example is built, so please+read on to see how it all works. For more complete(-ish) examples, see [this+test+case](https://github.com/goldfirere/units/blob/master/Tests/Compile/Simulator.hs)+(for examples of how to use units) and+[units-defs](https://github.com/goldfirere/units-defs) (for examples of how to+define units). +Dimension definitions+--------------------- +When setting up your well-typed units-of-measure program, the first step is+to define the dimensions you will be working in. (If your application involves+physical quantities, you may want to check `Data.Metrology.SI.Dims` in the+`units-defs` package first.) -Examples-========+    data LengthDim = LengthDim  -- each dimension is a datatype that acts as its own proxy+    instance Dimension LengthDim -**NOTE: THIS IS OUT OF DATE.**+    data TimeDim = TimeDim+    instance Dimension TimeDim +We can now build up dimensions from these base dimensions:++    type VelocityDim = LengthDim :/ TimeDim+ Unit definitions ---------------- -Here is how to define two inter-convertible units:+We then define units to work with these dimensions. Here, we define two different+inter-convertible units for length. (Note that just about all of this boilerplate+can be generated by functions in the `Data.Metrology.TH` module.) -    data Meter = Meter    -- each unit is a datatype that acts as its own proxy+    data Meter = Meter     instance Unit Meter where           -- declare Meter as a Unit       type BaseUnit Meter = Canonical   -- Meters are "canonical"+      type DimOfUnit Meter = LengthDim  -- Meters measure Lengths     instance Show Meter where           -- Show instances are optional but useful       show _ = "m"                      -- do *not* examine the argument! @@ -118,39 +162,115 @@     instance Unit Foot where       type BaseUnit Foot = Meter        -- Foot is defined in terms of Meter       conversionRatio _ = 0.3048        -- do *not* examine the argument!+                                        -- We don't need to specify the `DimOfUnit`;+                                        -- it's implied by the `BaseUnit`.     instance Show Foot where       show _ = "ft" -    type Length = MkQu Meter           -- we will manipulate Lengths-    type Length' = MkQu Foot           -- this is the *same* as Length+    data Second = Second+    instance Unit Second where+      type BaseUnit Second = Canonical+      type DimOfUnit Second = TimeDim+    instance Show Second where+      show _ = "s" -    extend :: Length -> Length          -- a function over lengths-    extend x = dim $ x .+ (1 % Meter)   -- more on this later+A unit assignment+----------------- -    inMeters :: Length -> Double        -- extract the # of meters-    inMeters = (# Meter)                -- more on this later+To perform computations with _units_, we must define a so-called _local coherent+set of units_, or LCSU. This is a mapping from dimensions to units, and it informs+exactly how the quantities are stored. For example: -Let's pick this apart. The `data Meter = Meter` declaration creates both the-type `Meter` and a term-level proxy for it. It would be possible to get away-without the proxies and lots of type annotations, but who would want to?-Then, we define an instance of `Unit` to make `Meter` into a proper unit.-The `Unit` class is primarily responsible for handling unit conversions.-In the case of `Meter`, we define that as the _canonical_ unit of length, meaning-that all lengths will internally be stored in meters. It also means that we-don't need to define a conversion ratio for meters.+    type LCSU = MkLCSU '[(LengthDim, Meter), (TimeDim, Second)] +This definition says that we wish to store lengths in meters and times in seconds.+Note that, even though `Meter` is defined as the `Canonical` length, we could have+used `Foot` in our LCSU. Canonical units are used only in conversion between+units, not the choice of how to store a quantity.++Value types+-----------++To use all these pieces to build the actual type that will store quantities, we+use one of the `MkQu_xxx` type synonyms, as follows:++    type Length = MkQu_DLN LengthDim LCSU Double+      -- Length stores lengths in our defined LCSU, using `Double` as the numerical type+    type Length' = MkQu_ULN Foot LCSU Double+      -- same as Length. Note the `U` in `MkQu_ULN`, allowing it to take a unit++    type Time = MkQu_DLN TimeDim LCSU Double++Some computations+-----------------++We now show some example computations on the defined types:++    extend :: Length -> Length            -- a function over lengths+    extend x = redim $ x |+| (1 % Meter)++    inMeters :: Length -> Double          -- extract the # of meters+    inMeters = (# Meter)                  -- more on this later++    conversion :: Length                  -- mixing units+    conversion = (4 % Meter) |+| (10 % Foot)++    vel :: Length %/ Time                 -- The `%*` and `%/` operators allow+                                          -- you to combine types+    vel = (3 % Meter) |/| (2 % Second)++Explanation+-----------++Let's pick this apart. The `data LengthDim = LengthDim` declaration creates both the+type `LengthDim` and a term-level proxy for it. It would be possible to get away+without the proxies and use lots of type annotations, but who would want to?+We must define an instance of `Dimension` to declare that `LengthDim` is a dimension.+Why suffix with `Dim`? To distinguish the length dimension from the length type.+Generally, the type is mentioned more often and should be the shorter name.++We then create a `TimeDim` to operate alongside the `LengthDim`. Using the+`:/` combinator, we can create a `VelocityDim` out of the two dimensions defined+so far. See below for more information on unit combinators.++Then, we make some units, using similar `data` definitions. We define an+instance of `Unit` to make `Meter` into a proper unit. The `Unit` class is+primarily responsible for handling unit conversions. In the case of `Meter`,+we define that as the _canonical_ unit of length, meaning that all lengths+will internally be stored in meters. It also means that we don't need to+define a conversion ratio for meters. You will also see that we say that+`Meter`s measure the dimension `LengthDim`, through the `DimOfUnit` declaration.+ We also include a `Show` instance for `Meter` so that lengths can be printed easily. If you don't need to `show` your lengths, there is no need for this instance.  When defining `Foot`, we say that its `BaseUnit` is `Meter`, meaning that-`Foot` is inter-convertible with `Meter`. We also must define the conversion+`Foot` is inter-convertible with `Meter`. This declaration also says that+the dimension measured by a `Foot` must be the same as the dimension for+a `Meter`. We must then define the conversion ratio, which is the number of meters in a foot. Note that the `conversionRatio` method must take a parameter to fix its type parameter, but it _must not_ inspect that parameter. Internally, it will be passed `undefined` quite often. -The `MkQu` type synonym makes a quantity for a given unit. Note+The definition for `Second` is quite similar to that for `Meter`.++The next section of code constructs an "LCSU" -- a local coherent set of units.+The idea is that we wish to be able to choose a set of units which are to be+used in the internal, concrete representation. An LCSU is just an association+list giving a concrete unit for each dimension in your domain. The particular+LCSU here says that length is stored in meters and time is stored in+seconds. It would be invalid to specify an LCSU with repeats for either+dimension or unit.++With all this laid out, we can make the types that store values. _units_+exports several `MkQu_xxx` type synonyms that vary in the arguments they+expect. `MkQu_DLN`, for example, takes a dimension, an LCSU, and a+numerical type. With the definition above, `Length` is now a type suitable+for storing lengths.++Note that `Length` and `Length'` are _the same type_. The `MkQu` machinery notices that these two are inter-convertible and will produce the same dimensioned quantity.@@ -159,7 +279,8 @@ to specify the choice of unit when creating a quantity or extracting from a quantity. Thus, other than thinking about the vagaries of floating point wibbles and the `Show` instance, it is _completely-irrelevant_ which unit is canonical. The type `Length` defined here could be+irrelevant_ which unit the concrete unit in the LCSU.+The type `Length` defined here could be used equally well in a program that deals exclusively in feet as it could in a program with meters. @@ -169,6 +290,9 @@ whether I was at the type level or the term level led me to use the former in my work. +Other features+==============+ Prefixes -------- @@ -200,22 +324,12 @@ Unit combinators ---------------- -There are several ways of combining units to create other units. Let's also-have a unit of time:--    data Second = Second-    instance Unit Second where-      type BaseUnit Second = Canonical-    instance Show Second where-      show _ = "s"--    type Time = MkQu Second-+There are several ways of combining units to create other units. Units can be multiplied and divided with the operators `:*` and `:/`, at either the term or type level. For example:      type MetersPerSecond = Meter :/ Second-    type Velocity1 = MkQu MetersPerSecond+    type Velocity1 = MkQu_ULN MetersPerSecond LCSU Double      speed :: Velocity1     speed = 20 % (Meter :/ Second)@@ -232,7 +346,7 @@ with a `p` (mnemonic: "power"). For example:      type MetersSquared = Meter :^ Two-    type Area1 = MkQu MetersSquared+    type Area1 = MkQu_ULN MetersSquared LCSU Double     type Area2 = Length %^ Two        -- same type as Area1      roomSize :: Area1@@ -248,7 +362,7 @@ -------------------  The haddock documentation shows the term-level quantity-combinators. The only one deserving special mention is `dim`, the+combinators. The only one deserving special mention is `redim`, the dimension-safe cast operator. Expressions written with the _units_ package can have their types inferred. This works just fine in practice, but the types are terrible, unfortunately. Much better is to use top-level annotations (using@@ -257,22 +371,51 @@ function may not exactly match up. This is because quantities have a looser notion of type equality than Haskell does. For example, "meter * second" should be the same as "second * meter", even though these are in-different order. The `dim` function checks (at compile time) to make sure its+different order. The `redim` function checks (at compile time) to make sure its input type and output type represent the same underlying dimension and then performs a cast from one to the other. This cast is completely free at runtime. When providing type annotations, it is good practice to start your-function with a `dim $` to prevent the possibility of type errors. For+function with a `redim $` to prevent the possibility of type errors. For example, say we redefine velocity a different way: -    type Velocity3 = Scalar %/ Time %* Length+    type Velocity3 = (MkQu_ULN Number LCSU Double) %/ Time %* Length     addVels :: Velocity1 -> Velocity1 -> Velocity3-    addVels v1 v2 = dim $ v1 .+ v2+    addVels v1 v2 = redim $ v1 |+| v2 -This is a bit contrived, but it demonstrates the point. Without the `dim`, the-`addVels` function would not type-check. Because `dim` needs to know its+This is a bit contrived, but it demonstrates the point. Without the `redim`, the+`addVels` function would not type-check. Because `redim` needs to know its _result_ type to type-check, it should only be used at the top level, such as here, where there is a type annotation to guide it. -Note that `dim` is _always_ dimension-safe -- it will not convert a time to a+Note that `redim` is _always_ dimension-safe -- it will not convert a time to a length! +Monomorphic behavior+====================++_units_ provides a facility for ignoring LCSUs, if your application does not+need to worry about numerical precision. The facility is through the type+family `DefaultUnitOfDim`. For example, with the definitions above, we could+say++    type instance DefaultUnitOfDim LengthDim = Meter+    type instance DefaultUnitOfDim TimeDim   = Second++and then use the `DefaultLCSU` for our LCSU. To make the use of the default+LCSU even easier, the `MkQu_xxx` operators that don't mention an LCSU all+use the default one. So, we can say++    type Length = MkQu_D LengthDim++and get to work. (This uses `Double` as the underlying numerical representation.)++The module `Data.Metrology.SI` from the _units-defs_ package exports type+instances for `DefaultUnitOfDim` for the SI types, meaning that you can use+definitions like this right away.++More examples+=============++Check out some of the test examples we have written to get more of a feel for+how this all works,+[here](https://github.com/goldfirere/units/tree/master/Test).
− Test/Travel.hs 
@@ -1,54 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeOperators #-}--module Main where--import Data.Metrology-import Data.Metrology.SI.Poly-import Data.Metrology.Imperial.Types (Imperial)-import Data.Metrology.Imperial.Units-import Data.Metrology.Show-import qualified Data.Metrology.SI.Dims as D--type PerArea lcsu n = MkQu_DLN (D.Area :^ MOne) lcsu n--fromGLtoED :: MkQu_DLN D.Length Imperial Float-fromGLtoED = 46.5 % Mile--fuelEfficiency :: PerArea Imperial Float-fuelEfficiency = 40 % (Mile :/ Gallon)--gasolineDensity :: MkQu_DLN D.Density Imperial Float-gasolineDensity = 7.29 % (Pound :/ Gallon)--gasolineWeight :: (Fractional f) -  => MkQu_DLN D.Length su f -> PerArea su f -> MkQu_DLN D.Density su f -> MkQu_DLN D.Mass su f-gasolineWeight len0 ef0 den0 = len0 |/| ef0 |*| den0---main :: IO ()-main = do-  putStrLn $ fromGLtoED `showIn` Mile-  putStrLn $ fuelEfficiency `showIn` Mile :/ Gallon-  putStrLn $ gasolineDensity `showIn` Pound :/ Gallon-  putStrLn $ show $ gasolineWeight fromGLtoED fuelEfficiency gasolineDensity --  putStrLn ""-  putStrLn $ fromGLtoED `showIn` (kilo Meter)-  putStrLn $ fuelEfficiency `showIn`  kilo Meter :/ Liter-  putStrLn $ gasolineDensity `showIn` kilo Gram :/ Liter-  putStrLn $ show $ (gasolineWeight -    (convert fromGLtoED) (convert fuelEfficiency) (convert gasolineDensity) :: MkQu_DLN D.Mass SI Float)--{---- Execution result ----46.5 mi-39.999996 mi/gal-7.29 lb/gal-8.474626 lb--74.834496 km-14.160248 km/l-0.7273698 kg/l-3.8440251 kg--}
+ Tests/Compile/CGS.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE DataKinds, TypeOperators #-}++module Tests.Compile.CGS where++import Data.Metrology+import Data.Metrology.SI+import qualified Data.Metrology.SI.Dims as D++type CGS = MkLCSU '[ (D.Length, Centi :@ Meter)+                   , (D.Mass, Gram)+                   , (D.Time, Second) ]++type CGSLength = MkQu_DLN D.Length CGS Double+type CGSMass = MkQu_DLN D.Mass CGS Double+type CGSTime = MkQu_DLN D.Time CGS Double
+ Tests/Compile/EvalType.hs view
@@ -0,0 +1,16 @@+{- Tests evalType+   Copyright (c) 2014 Richard Eisenberg+-}++{-# LANGUAGE TemplateHaskell, FlexibleInstances, DataKinds #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Tests.Compile.EvalType where++import Data.Metrology.TH+import Data.Metrology.SI+import Data.Metrology++instance Show $(evalType [t| Length |]) where+  show x = x `showIn` Meter+
+ Tests/Compile/Lcsu.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TypeFamilies, DataKinds #-}++module Tests.Compile.Lcsu where++import Data.Metrology.Poly hiding (LCSU)++data Length = Length+data Time = Time++data Meter = Meter+data Second = Second++data Centi = Centi++instance Dimension Length+instance Dimension Time++instance Unit Meter where+  type BaseUnit Meter = Canonical+  type DimOfUnit Meter = Length+instance Unit Second where+  type BaseUnit Second = Canonical+  type DimOfUnit Second = Time++instance Unit Centi where+  type BaseUnit Centi = Meter+  conversionRatio _ = 0.01++data Foot = Foot+instance Unit Foot where+  type BaseUnit Foot = Meter+  conversionRatio _ = 0.3048++type LCSU = MkLCSU '[(Length, Meter),  (Time, Second)]++inMeters :: Qu '[F Length One] LCSU Double+inMeters = quOf 3 Meter
+ Tests/Compile/MetrologySynonyms.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Tests.Compile.MetrologySynonyms where++import           Data.Metrology+import           Data.Metrology.SI.Poly+import           Data.Metrology.Unsafe+import           Text.Printf++----------------------------------------------------------------+-- Pretty Printing Functions+----------------------------------------------------------------++ppValF :: PrintfArg x => String -> Qu d l x -> String+ppValF fmtStr (Qu x) = printf fmtStr x --  ++ showFactor (Proxy :: Proxy (LookupList dims lcsu)))++ppValE :: PrintfArg x => Int -> Qu d l x -> String+ppValE d (Qu x) = ret+  where+    fmtStr :: String+    fmtStr = printf "%%.%de" d+    +    protoStr :: String+    protoStr = printf fmtStr x++    (valPart,expPart) = break (=='e') protoStr+    +    ret = case expPart of+      "e0" -> valPart+      _ -> printf "%s \\times 10^{%s}" valPart (drop 1 expPart)++++----------------------------------------------------------------+-- Nonweighted units+----------------------------------------------------------------++type PerSecond =  Number :/ Second+type PerCm3 =  Second :^ MThree+type PerCm2 =  Second :^ MTwo+type PerCm = (Centi :@ Meter) :^ MTwo +type GHz =  (Giga :@ Hertz)++----------------------------------------------------------------+-- Weighted units+----------------------------------------------------------------++-- densities+type GramPerCm2 = Gram :* PerCm2+type GramPerCm3 = Gram :* PerCm3 ++type JouleM3 = Joule :/ (Meter :^ Three)+++-- see the table in http://en.wikipedia.org/wiki/Spectral_irradiance+type SpectralRadiance = Watt :/ (Meter :^ Two) :/ Hertz+++-- | Spectral Flux Density+-- type SpectralFluxDensity = '[ '(Mass, POne), '(Time, NTwo)] +-- |Unit of EDP+data Jansky = Jansky+instance Show Jansky where show _ = "Jy"++instance Unit Jansky where+  type BaseUnit Jansky = Joule :/ (Meter :^ Two) :* Second+  conversionRatio _ = 1e-26+++-- energies+data ElectronVolt = ElectronVolt+instance Show ElectronVolt where show _ = "eV"+instance Unit ElectronVolt where+  type BaseUnit ElectronVolt = Joule +  conversionRatio _ = 1.60217657e-19+++type JouleSecond = Joule :* Second+++-- velocities+type KmPerSec = (Kilo :@ Meter) :/ Second+type MPerSec = Meter :/ Second+type CmPerSec = (Centi :@ Meter) :/ Second++type Kg = Kilo :@ Gram++type GramPerMole = Gram :/ Mole+++data AU = AU+instance Show AU where show _ = "au"+instance Unit AU where+  type BaseUnit AU = Meter+  conversionRatio _ = 149597870700 ++data Parsec = Parsec+instance Show Parsec where show _ = "pc"+instance Unit Parsec where+  type BaseUnit Parsec = Meter+  conversionRatio _ = 3.08567758e16++++-- squared velocities+type Cm2PerSec2 = CmPerSec :^ Two+type Meter2PerSec2 = MPerSec :^ Two+type Sec2PerMeter2 = MPerSec :^ MTwo++-- areas+type Meter2 = Meter :^ Two+type Cm2 = (Centi :@ Meter) :^ Two++type SIGCUnit =+  (Meter :^ Three) :* ((Kilo :@ Gram) :^ MOne) :* (Second :^ MTwo)+type SIkBUnit = Joule :/ Kelvin+++----------------------------------------------------------------+-- Electric Units+----------------------------------------------------------------+type VoltPerCm = Volt :/ (Centi :@ Meter)+type KVPerCm = (Kilo :@ Volt) :/ (Centi :@ Meter)+++type CoulombPerCm2 = Coulomb :/ Cm2++-- eps0+type SIPermittivityUnit = +  ((Kilo :@ Gram) :^ MOne) :*+  (Meter :^ MThree) :*+  (Second :^ Four) :*+  (Ampere :^ Two)++-- mu0+type SIPermeabilityUnit = +  ((Kilo :@ Gram) :^ One) :*+  (Meter :^ One) :*+  (Second :^ MTwo) :*+  (Ampere :^ MTwo)+++-- dipole moment+data Debye = Debye+instance Unit Debye where+  type BaseUnit Debye = Coulomb :* Meter+  conversionRatio _ = 1e-21/299792458+  +
+ Tests/Compile/NoVector.hs view
@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-missing-signatures #-}++module Tests.Compile.NoVector where++import Data.Metrology+import Data.Metrology.SI++x = 5 % Meter+y = 2 % Second+vel = x |/| y
+ Tests/Compile/Physics.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE TypeOperators, ConstraintKinds, ScopedTypeVariables, TypeFamilies,+             FlexibleContexts, DataKinds #-}++module Tests.Compile.Physics where++import Data.Metrology.Poly+import Data.Metrology.SI.Poly ( SI )+import Data.Metrology.SI.Dims+import Data.Metrology.SI.Prefixes+import Data.Metrology.SI.Units+import Tests.Compile.CGS++type Position = Length++cur_pos :: MkQu_DLN Position lcsu Double+        -> MkQu_DLN Velocity lcsu Double+        -> MkQu_DLN Acceleration lcsu Double+        -> MkQu_DLN Time lcsu Double+        -> MkQu_DLN Position lcsu Double+cur_pos x0 v a t = x0 |+| (v |*| t) |+| (0.5 *| a |*| (t |^ sTwo))++siPos :: MkQu_DLN Position SI Double+siPos = 3 % Meter++siVel :: MkQu_DLN Velocity SI Double+siVel = 2 % (Meter :/ Second)++siAcc :: MkQu_DLN Acceleration SI Double+siAcc = 10 % (Meter :/ Second :/ Second)++siTime :: MkQu_DLN Time SI Double+siTime = 4 % Second++siMass :: MkQu_DLN Mass SI Double+siMass = 1 % (Kilo :@ Gram)++cgsPos :: MkQu_DLN Position CGS Double+cgsPos = 3 % Meter++cgsVel :: MkQu_DLN Velocity CGS Double+cgsVel = 2 % (Meter :/ Second)++cgsAcc :: MkQu_DLN Acceleration CGS Double+cgsAcc = 10 % (Meter :/ Second :/ Second)++cgsTime :: MkQu_DLN Time CGS Double+cgsTime = 4 % Second++cgsMass :: MkQu_DLN Mass CGS Double+cgsMass = 1 % (Kilo :@ Gram)++kinetic_energy :: MkQu_DLN Mass lcsu Double+               -> MkQu_DLN Velocity lcsu Double+               -> MkQu_DLN Energy lcsu Double+kinetic_energy m v = redim $ 0.5 *| m |*| v |*| v++momentum :: MkQu_DLN Mass l Double+         -> MkQu_DLN Velocity l Double+         -> MkQu_DLN Momentum l Double+momentum m v = redim $ m |*| v++g_earth :: CompatibleUnit lcsu (Meter :/ (Second :^ Two))+        => MkQu_DLN Acceleration lcsu Double+g_earth = 9.8 % (Meter :/ (Second :^ sTwo))++distance :: MkQu_DLN Velocity lcsu Double+         -> MkQu_DLN Acceleration lcsu Double+         -> MkQu_DLN Time lcsu Double+         -> MkQu_DLN Length lcsu Double+distance v a t = redim $ v |*| t |+| (0.5 *| a |*| t |*| t)++sum :: Num n => [Qu dims l n] -> Qu dims l n+sum = foldr (|+|) zero++squareAll :: Fractional n => [Qu dims l n] -> [Qu (dims @* Two) l n]+squareAll = map (|^ sTwo)
+ Tests/Compile/Quantity.hs view
@@ -0,0 +1,35 @@+{- Test Quantity instance+   Copyright (c) 2014 Richard Eisenberg+-}++{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-}++module Tests.Compile.Quantity where++import Data.Metrology.Poly+import Data.Metrology.Quantity+import Data.Metrology.SI.Poly+import Data.Metrology.SI   ()  -- DefaultLCSU instances++len1 :: Length SI Double+len1 = 5 % Meter++len2 :: Length SI Double+len2 = fromQuantity len1++len3 :: Length SI Double+len3 = toQuantity len1++force1, force2, force3 :: Energy DefaultLCSU Double+force1 = 10 % Joule+force2 = fromQuantity force1+force3 = toQuantity force1++newtype MyTime = MyTime { getTime :: Double }   -- measured in seconds++instance Quantity MyTime where+  type QuantityUnit MyTime = Second+  type QuantityLCSU MyTime = SI++  fromQuantity = MyTime . (# Second)+  toQuantity = (% Second) . getTime
+ Tests/Compile/Readme.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds #-}++module Tests.Compile.Readme where++    import Data.Metrology.Poly hiding (LCSU)++    data LengthDim = LengthDim  -- each dimension is a datatype that acts as its own proxy+    instance Dimension LengthDim++    data TimeDim = TimeDim+    instance Dimension TimeDim++    type VelocityDim = LengthDim :/ TimeDim+    data Meter = Meter+    instance Unit Meter where           -- declare Meter as a Unit+      type BaseUnit Meter = Canonical   -- Meters are "canonical"+      type DimOfUnit Meter = LengthDim  -- Meters measure Lengths+    instance Show Meter where           -- Show instances are optional but useful+      show _ = "m"                      -- do *not* examine the argument!++    data Foot = Foot+    instance Unit Foot where+      type BaseUnit Foot = Meter        -- Foot is defined in terms of Meter+      conversionRatio _ = 0.3048        -- do *not* examine the argument!+                                        -- We don't need to specify the `DimOfUnit`;+                                        -- it's implied by the `BaseUnit`.+    instance Show Foot where+      show _ = "ft"++    data Second = Second+    instance Unit Second where+      type BaseUnit Second = Canonical+      type DimOfUnit Second = TimeDim+    instance Show Second where+      show _ = "s"++    type LCSU = MkLCSU '[(LengthDim, Meter), (TimeDim, Second)]++    type Length = MkQu_DLN LengthDim LCSU Double+      -- Length stores lengths in our defined LCSU, using `Double` as the numerical type+    type Length' = MkQu_ULN Foot LCSU Double+      -- same as Length. Note the `U` in `MkQu_ULN`, allowing it to take a unit++    type Time = MkQu_DLN TimeDim LCSU Double++    extend :: Length -> Length            -- a function over lengths+    extend x = redim $ x |+| (1 % Meter)++    inMeters :: Length -> Double          -- extract the # of meters+    inMeters = (# Meter)                  -- more on this later++    conversion :: Length                  -- mixing units+    conversion = (4 % Meter) |+| (10 % Foot)++    vel :: Length %/ Time                 -- The `%*` and `%/` operators allow+                                          -- you to combine types+    vel = (3 % Meter) |/| (2 % Second)++    data Kilo = Kilo+    instance UnitPrefix Kilo where+      multiplier _ = 1000++    kilo :: unit -> Kilo :@ unit+    kilo = (Kilo :@)++    longWayAway :: Length+    longWayAway = 150 % kilo Meter++    longWayAwayInMeters :: Double+    longWayAwayInMeters = longWayAway # Meter  -- 150000.0++    type MetersPerSecond = Meter :/ Second+    type Velocity1 = MkQu_ULN MetersPerSecond LCSU Double++    speed :: Velocity1+    speed = 20 % (Meter :/ Second)++    type Velocity2 = Length %/ Time    -- same type as Velocity1++    type MetersSquared = Meter :^ Two+    type Area1 = MkQu_ULN MetersSquared LCSU Double+    type Area2 = Length %^ Two        -- same type as Area1++    roomSize :: Area1+    roomSize = 100 % (Meter :^ sTwo)++    roomSize' :: Area1+    roomSize' = 100 % (Meter :* Meter)++    type Velocity3 = (MkQu_ULN Number LCSU Double) %/ Time %* Length+    addVels :: Velocity1 -> Velocity1 -> Velocity3+    addVels v1 v2 = redim $ (v1 |+| v2)++    type instance DefaultUnitOfDim LengthDim = Meter+    type instance DefaultUnitOfDim TimeDim   = Second++    -- type Length = MkQu_D LengthDim+
+ Tests/Compile/Simulator.hs view
@@ -0,0 +1,126 @@+{- Copyright (c) 2013-4 Richard Eisenberg++This file demonstrates some of `units`'s capabilities by building up a simple+physics simulator.+-}++{-# LANGUAGE TypeOperators, TypeFamilies, QuasiQuotes #-}++module Tests.Compile.Simulator where++import Data.Metrology.SI+import Data.Metrology.Show ()+import Data.Metrology.Vector++-- We never want to add positions! QPoint protects us from this.+type Position = QPoint Length++-- +x = right+-- +y = up++-- We still want the "outer" type to be Qu, not the pair. So push the pairing+-- operation down to the Qu's representation.+type family Vec2D x where+  Vec2D (Qu d l n) = Qu d l (n, n)++-- An object in our little simulation+data Object = Object { mass :: Mass+                     , rad  :: Length+                     , pos  :: Vec2D Position+                     , vel  :: Vec2D Velocity }+  deriving Show++type Universe = [Object]++-- updating takes two passes: move everything according to their own positions+-- and gravity (ignoring pulls between objects), and then look for collisions+-- and update collided objects' positions and velocities accordingly. This might+-- fail if three objects were to collide in a row all at once.++g :: Vec2D Acceleration+g = (0,-9.8)% [si| m/s^2 |]  -- could also be Meter :/ (Second :^ sTwo)++g_universe :: Force %* Length %^ Two %/ (Mass %^ Two)+g_universe = 6.67e-11 % [si| N m^2 / kg^2 |]++update :: Time -> Universe -> Universe+update dt objs+  = let objs1 = map (updateNoColls dt objs) objs in+    updateColls objs1++-- update without taking collisions into account+updateNoColls :: Time -> Universe -> Object -> Object+updateNoColls dt univ obj@(Object { mass = m, pos = x, vel = dx })+  = let new_pos = x |.+^| dx |^*| dt  -- new position+        v1 = dx |+| g |^*| dt         -- new velocity w.r.t. downward gravity+        f = gravityAt univ x m+        a = f |^/| m+        v2 = v1 |+| a |^*| dt         -- new velocity also with mutual gravity+    in obj { pos = new_pos, vel = v2 }++-- calculate the gravity at a point from all other masses+gravityAt :: Universe -> Vec2D Position -> Mass -> Vec2D Force+gravityAt univ p m = qSum (map gravity_at_1 univ)+  where+    -- gravity caused by just one point+    gravity_at_1 (Object { mass = m1, pos = pos1 })+      = let r = p |.-.| pos1+            f = g_universe |*| m1 |*| m |*^| r |^/| (qMagnitude r |^ sThree)+        in+        if qMagnitude r |>| (zero :: Length)  -- exclude the point itself!+        then redim f +        else zero++-- update by collisions+updateColls :: Universe -> Universe+updateColls objs+  = let collisions = findCollisions objs in+    map resolveCollision collisions++-- returns a list of collisions, as pairs of an object with, perhaps,+-- a collision partner+findCollisions :: Universe -> [(Object, Maybe Object)]+findCollisions objs+  = map (findCollision objs) objs++-- check for collisions for one particular Object+findCollision :: Universe -> Object -> (Object, Maybe Object)+findCollision [] obj = (obj, Nothing)+findCollision (other : rest) obj+  | colliding other obj+  = (obj, Just other)+  | otherwise+  = findCollision rest obj++-- are two objects in contact?+colliding :: Object -> Object -> Bool+colliding (Object { pos = x1, rad = rad1 })+          (Object { pos = x2, rad = rad2 })+  = let distance = qDistance x1 x2 in+    distance |>| (zero :: Length) && distance |<=| (rad1 |+| rad2)++-- resolve the collision between two objects, updating only the first+-- object in the pair. The second object will be updated in a separate+-- (symmetric) call.+resolveCollision :: (Object, Maybe Object) -> Object+resolveCollision (obj, Nothing) = obj+resolveCollision (obj@Object { mass = m1, rad = rad1+                             , pos = z1, vel = v1 },+                Just (Object { mass = m2, rad = rad2+                             , pos = z2, vel = v2 }))+  = let -- c :: Vec2D Length+        c = z2 |.-.| z1   -- vector from z1 to z2++        -- vc1, vc2, vd1, vc1', v1' :: Vec2D Velocity+        vc1 = c `qProject` v1  -- component of v1 along c+        vc2 = c `qProject` v2  -- component of v2 along c+        vd1 = v1 |-| vc1       -- component of v1 orthogonal to c+        vc1' = (m1 |*^| vc1 |-| m2 |*^| vc2 |+| 2 *| m2 |*^| vc2) |^/| (m1 |+| m2)+                               -- new component of v1 along c+        v1' = vc1' |+| vd1     -- new v1++          -- also, move object 1 to be out of contact with object 2+        z1' = z2 |.-^| (rad1 |+| rad2) |*^| qNormalized c+    in+    obj { pos = z1', vel = v1' }+
+ Tests/Compile/T23.hs view
@@ -0,0 +1,12 @@+{- Regression test for #23 -}++{-# LANGUAGE TypeOperators, ConstraintKinds, FlexibleContexts #-}++module Tests.Compile.T23 where++import Data.Metrology.Poly+import Data.VectorSpace++ratio :: (d1 @~ d2, VectorSpace n, Fractional (Scalar n), Fractional n)+      => Qu d1 l n -> Qu d2 l n -> n+ratio x y = (x |/| y) # Number
+ Tests/Compile/TH.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE TemplateHaskell, DataKinds, TypeFamilies #-}++module Tests.Compile.TH where++import Data.Metrology.TH+import Data.Metrology.Poly+import qualified Data.Metrology as Mono++$(declareDimension "Length")+$(declareCanonicalUnit "Meter" ''Length (Just "m"))+$(declareDerivedUnit "Foot" ''Meter 0.3048 Nothing)++type MyLCSU = MkLCSU '[(Length, Meter)]++len1 :: MkQu_DLN Length MyLCSU Double+len1 = 5 % Meter++len2 :: MkQu_DLN Length MyLCSU Double+len2 = 10 % Foot++$(declareMonoUnit "Second" (Just "s"))+type Time = MkQu_D Second++time :: Time+time = 10 Mono.% Second
+ Tests/Compile/UnitParser.hs view
@@ -0,0 +1,46 @@+{- Test units package quasiquoter mechanism+   Copyright (c) 2014 Richard Eisenberg+-}++{-# LANGUAGE QuasiQuotes, CPP, DataKinds #-}++module Tests.Compile.UnitParser where++import Tests.Compile.UnitParser.Quoters ( ms )+import Data.Metrology.SI+import Data.Metrology++len1, len2 :: Length+len1 = 5 % [ms| m |]+len2 = redim $ 10 % [ms| s km / ms |]++vel1, vel2, vel3, vel4 :: Velocity+vel1 = 5 % [ms| m/s |]+vel2 = redim $ 10 % [ms| m s/s^2 |]+vel3 = redim $ 15 % [ms| m 1 / s 1 |]+vel4 = redim $ 20 % [ms| m /(1*1*s) |]++acc1, acc2 :: Acceleration+acc1 = 5 % [ms| m/s^2 |]+acc2 = redim $ 10 % [ms| m/s s |]++#if __GLASGOW_HASKELL >= 709+len3 :: Length+len3 = 15 % [unit| μm |]++freq :: Frequency+freq = 100 % [unit| MHz |]+#endif++lenty :: MkQu_U [ms| m |]+lenty = 5 % Meter++velty :: MkQu_U [ms| m/s |]+velty = 5 % (Meter :/ Second)++freqty :: MkQu_U [ms| s^-1 |]+freqty = 5 % Hertz++num1, num2 :: Count+num1 = 3 % [ms|  |]+num2 = 4 % [ms| 1 |]
+ Tests/Compile/UnitParser/Quoters.hs view
@@ -0,0 +1,18 @@+{- Define test quasiquoters+   Copyright (c) 2014 Richard Eisenberg+-}++{-# LANGUAGE TemplateHaskell, CPP #-}++module Tests.Compile.UnitParser.Quoters where++import Data.Metrology.Parser+import Data.Metrology.SI++$(makeQuasiQuoter "ms" [''Milli, ''Kilo] [''Meter, ''Second])++#if __GLASGOW_HASKELL__ >= 709+$(do units <- allUnits+     prefixes <- allPrefixes+     makeQuasiQuoter "unit" units prefixes)+#endif
+ Tests/Compile/Units.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators #-}++module Tests.Compile.Units where++import Data.Metrology++data Meter = Meters+data Foot = Feet+data Yard = Yards++type Length = MkQu_U Meter+type Time = MkQu_U Second++data LengthD = LengthD+instance Dimension LengthD+data TimeD = TimeD+instance Dimension TimeD++instance Unit Meter where+  type BaseUnit Meter = Canonical+  type DimOfUnit Meter = LengthD++instance Unit Foot where+  type BaseUnit Foot = Meter+  conversionRatio _ = 0.3048++instance Unit Yard where+  type BaseUnit Yard = Foot+  conversionRatio _ = 3++data Second = Seconds+instance Unit Second where+  type BaseUnit Second = Canonical+  type DimOfUnit Second = TimeD++data Hertz = Hertz+instance Unit Hertz where+  type BaseUnit Hertz = Number :/ Second+  conversionRatio _ = 1+
+ Tests/Imperial.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE TypeOperators, TypeFamilies, ImplicitParams, NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Tests.Imperial where++import Data.Metrology+import Data.Metrology.SI++import Test.Tasty+import Test.Tasty.HUnit+import Test.HUnit.Approx++data Mile = Mile+instance Unit Mile where+  type BaseUnit Mile = Meter+  conversionRatio _ = 1609.34++data Pound = Pound+instance Unit Pound where+  type BaseUnit Pound = Kilo :@ Gram+  conversionRatio _ = 0.453592++tests =+  testGroup "Imperial" +  [ testCase "Mile" ((1 % Mile :: Length) # Meter @?~ 1609.34) +  , testCase "Pound"  ((1 % Pound :: Mass) # kilo Gram @?~ 0.453592) ] +
+ Tests/LennardJones.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ImplicitParams #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Tests.LennardJones where++import Data.Metrology.Poly+import Data.Metrology.Z+import Data.Metrology.SI.Mono         ()+import Data.Metrology.SI.PolyTypes+import Data.Metrology.SI.Prefixes+import Data.Metrology.SI.Units+import Data.Metrology.SI.Poly (SI)+import qualified Data.Metrology.SI.Dims as D+-- import Data.Metrology.Show++import Test.Tasty+import Test.Tasty.HUnit+import Test.HUnit.Approx++type Six      = S Five+type Seven    = S Six+type Eight    = S Seven+type Nine     = S Eight+type Ten      = S Nine+type Eleven   = S Ten+type Twelve   = S Eleven+type Thirteen = S Twelve+++sSix     = SS sFive+sSeven   = SS sSix     +sEight   = SS sSeven   +sNine    = SS sEight   +sTen     = SS sNine    +sEleven  = SS sTen     +sTwelve  = SS sEleven  +sThirteen= SS sTwelve  +++data EV = EV+instance Show EV where show _ = "eV"+instance Unit EV where+  type BaseUnit EV = Joule +  conversionRatio _ = 1.60217657e-19++data ProtonMass = ProtonMass+instance Show ProtonMass where show _ = "m_p"+instance Unit ProtonMass where+  type BaseUnit ProtonMass = Kilo :@ Gram+  conversionRatio _ = 1.67262178e-27++data Å = Å+instance Show Å where show _ = "Å"+instance Unit Å where+  type BaseUnit Å = Meter+  conversionRatio _ = 1e-8+++-- | chemist's unit+type CU = MkLCSU '[ (D.Length, Å)+                  , (D.Mass, ProtonMass)+                  , (D.Time, Pico :@ Second)]++protonMass :: Mass SI Float+protonMass =  1 % ProtonMass++sigmaAr :: Length SI Float+sigmaAr = 3.4e-8 % Meter++epsAr :: Energy SI Float+epsAr = 1.68e-21 % Joule++ljForce :: Length SI Float -> Force SI Float+ljForce r = redim $ 24 *| epsAr |*| sigmaAr|^ sSix |/| r |^ sSeven+                |-| 48 *| epsAr |*| sigmaAr|^ sTwelve |/| r |^ sThirteen+++type AParameterDim = D.Energy :* D.Length :^ Twelve+type BParameterDim = D.Energy :* D.Length :^ Six++type APara = MkQu_DLN AParameterDim+type BPara = MkQu_DLN BParameterDim++ljForceP :: Energy l Float -> Length l Float -> Length l Float -> Force l Float+ljForceP eps sigma r +  = redim $ 24 *| eps |*| sigma|^ sSix |/| r |^ sSeven+        |-| 48 *| eps |*| sigma|^ sTwelve |/| r |^ sThirteen+++aParaAr :: (ConvertibleLCSUs_D D.Length SI l , ConvertibleLCSUs_D D.Energy SI l )=> APara l Float+aParaAr = 48 *|  convert epsAr  |*| convert sigmaAr|^ sTwelve++bParaAr :: (ConvertibleLCSUs_D D.Length SI l , ConvertibleLCSUs_D D.Energy SI l )=>  BPara l Float+bParaAr = 24 *|  convert epsAr  |*| convert sigmaAr|^ sSix++++++ljForcePOpt :: APara l Float -> BPara l Float -> Length l Float -> Force l Float+ljForcePOpt a b r +  = redim $ b |/| r |^ sSeven+        |-| a |/| r |^ sThirteen+++sigmaAr' :: (DefaultConvertibleLCSU_D D.Length l) => Length l Float+sigmaAr' = constant $ 3.4e-8 % Meter+epsAr' :: (DefaultConvertibleLCSU_D D.Energy l) => Energy l Float+epsAr' = constant $ 1.68e-21 % Joule+++aParaAr' :: (DefaultConvertibleLCSU_D AParameterDim l) => APara l Float+aParaAr' = constant $ 48 *|  epsAr'  |*| sigmaAr'|^ sTwelve++bParaAr' :: (DefaultConvertibleLCSU_D BParameterDim l) => BPara l Float+bParaAr' = constant $ 24 *|  epsAr'  |*| sigmaAr'|^ sSix++++sigmaAr'' :: (ConvertibleLCSUs_D D.Length CU l) => Length l Float+sigmaAr'' = convert $ (3.4e-8 % Meter :: Length CU Float)+epsAr'' :: (ConvertibleLCSUs_D D.Energy CU l) => Energy l Float+epsAr'' = convert $ (1.68e-21 % Joule :: Energy CU Float)++aParaAr'' :: (ConvertibleLCSUs_D AParameterDim CU l) => APara l Float+aParaAr'' = convert $ ((48 :: Float) *|  epsAr'  |*| sigmaAr'|^ sTwelve :: APara CU Float)++bParaAr'' :: (ConvertibleLCSUs_D BParameterDim CU l) => BPara l Float+bParaAr'' = convert $ ((24 :: Float) *|  epsAr'  |*| sigmaAr'|^ sSix :: BPara CU Float)++tests :: TestTree+tests =+  let ?epsilon = 0.0001 in -- need this because we need Floats, not Doubles!+  let ans :: (ConvertibleLCSUs_D D.Length SI l, ConvertibleLCSUs_D D.Energy SI l) => Force l Float+      ans = ljForceP (convert epsAr) (convert sigmaAr) (4 % Å)+      val = 9.3407324e-14+  in+  testGroup "LennardJones"+  [ testCase "NaN" (assert (isNaN $ ljForce (4 % Å) # Newton))+  , testCase "NaNPoly" (assert (isNaN $ (ljForceP (convert epsAr) (convert sigmaAr) (4 % Å) :: Force SI Float) # Newton))+  , testCase "CU" ((ljForceP (convert epsAr) (convert sigmaAr) (4 % Å) :: Force CU Float) # Newton @?~ val)+  , testCase "ansNaN" (assert $ isNaN $ (ans :: Force SI Float) # Newton)+  , testCase "ansCU" ((ans :: Force CU Float) # Newton @?~ val)+  , testCase "optNaN" (assert $ isNaN $ (ljForcePOpt aParaAr bParaAr (4%Å) :: Force SI Float) # Newton)+  , testCase "optCU" ((ljForcePOpt aParaAr bParaAr (4%Å) :: Force CU Float) # Newton @?~ val)+  , testCase "precompNaN" (assert $ isNaN $ (ljForcePOpt aParaAr' bParaAr' (4%Å) :: Force SI Float) # Newton)+  , testCase "precompNaN2" (assert $ isNaN $ (ljForcePOpt aParaAr' bParaAr' (4%Å) :: Force CU Float) # Newton)+  , testCase "precompPolyNaN" (assert $ isNaN $ (ljForcePOpt aParaAr'' bParaAr'' (4%Å) :: Force SI Float) # Newton)+  , testCase "precompPolyCU" ((ljForcePOpt aParaAr'' bParaAr'' (4%Å) :: Force CU Float) # Newton @?~ val) ]+{-+main :: IO ()+main = do++  putStrLn "He insists that it's better to do chemistry in CU than SI."+  putStrLn "For example, the attractive force between two Argon atom at the distance of 4Å is:"+  putStrLn $ ljForce (4 % Å) `showIn` (Newton)+  putStrLn "Oops, let's do it polymorphically:"+  putStrLn $ (ljForceP (convert epsAr) (convert sigmaAr) (4 % Å) :: Force SI Float) `showIn` (Newton)+  putStrLn "I can't do it in SI! On the other hand in CU we can:"+  putStrLn $ (ljForceP (convert epsAr) (convert sigmaAr) (4 % Å) :: Force CU Float) `showIn` (Newton)+++  -- how would you type it polymorphically (not using the default LCSU)?+  let ans :: (ConvertibleLCSUs_D D.Length SI l, ConvertibleLCSUs_D D.Energy SI l)=> Force l Float+      ans = ljForceP (convert epsAr) (convert sigmaAr) (4 % Å)++  putStrLn "We compare again:"  +  putStrLn $ (ans :: Force SI Float) `showIn` (Newton)+  putStrLn $ (ans :: Force CU Float) `showIn` (Newton)+++  putStrLn $ "Let's optimize the computation by precomputing all the constants."+  putStrLn $ (ljForcePOpt aParaAr bParaAr (4%Å):: Force SI Float) `showIn` Newton+  putStrLn $ (ljForcePOpt aParaAr bParaAr (4%Å):: Force CU Float) `showIn` Newton++  putStrLn $ "We cannot use the default LCSU for calculating constants in this case."+  putStrLn $ (ljForcePOpt aParaAr' bParaAr' (4%Å):: Force SI Float) `showIn` Newton+  putStrLn $ (ljForcePOpt aParaAr' bParaAr' (4%Å):: Force CU Float) `showIn` Newton+  +  putStrLn $ "We must pay attention in which LCSU the constants are computed in."+  putStrLn $ (ljForcePOpt aParaAr'' bParaAr'' (4%Å):: Force SI Float) `showIn` Newton+  putStrLn $ (ljForcePOpt aParaAr'' bParaAr'' (4%Å):: Force CU Float) `showIn` Newton  ++++{--- output ---+A chemist said his favorite system of unit (CU) consists of an Ångstrom, a proton mass, and a picosecond. They are 1.0e-8 m, 1.6726218e-27 kg, and 1.0e-12 s, respectively.+He insists that it's better to do chemistry in CU than SI.+For example, the attractive force between two Argon atom at the distance of 4Å is:+NaN N+Oops, let's do it polymorphically:+NaN N+I can't do it in SI! On the other hand in CU we can:+9.3407324e-14 N+We compare again:+NaN N+9.3407324e-14 N+Let's optimize the computation by precomputing all the constants.+NaN N+9.3407324e-14 N+We cannot use the default LCSU for calculating constants in this case.+NaN N+NaN N+We must pay attention in which LCSU the constants are computed in.+NaN N+9.3407324e-14 N+-}+-}
+ Tests/Main.hs view
@@ -0,0 +1,55 @@+{- Test/Main.hs++   The units Package+   Copyright (c) 2014 Richard Eisenberg+   eir@cis.upenn.edu++   This is the main testing file for the units package.+-}++{-# LANGUAGE ImplicitParams #-}++module Tests.Main where++import qualified Tests.Compile.CGS               ()+import qualified Tests.Compile.EvalType          ()+import qualified Tests.Compile.Lcsu              ()+import qualified Tests.Compile.MetrologySynonyms ()+import qualified Tests.Compile.NoVector          ()+import qualified Tests.Compile.Physics           ()+import qualified Tests.Compile.Quantity          ()+import qualified Tests.Compile.Readme            ()+import qualified Tests.Compile.Simulator         ()+import qualified Tests.Compile.TH                ()+import qualified Tests.Compile.UnitParser        ()+import qualified Tests.Compile.Units             ()++import qualified Tests.Compile.T23               ()++import qualified Tests.Imperial+import qualified Tests.LennardJones+import qualified Tests.OffSystemAdd+import qualified Tests.OffSystemCSU+import qualified Tests.Parser+import qualified Tests.PhysicalConstants+import qualified Tests.Show+import qualified Tests.Travel++import Test.Tasty++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+  let ?epsilon = 0.0000001 in+  testGroup "Tests"+  [ Tests.Imperial.tests+  , Tests.LennardJones.tests+  , Tests.OffSystemAdd.tests+  , Tests.OffSystemCSU.tests+  , Tests.Parser.tests+  , Tests.PhysicalConstants.tests+  , Tests.Show.tests+  , Tests.Travel.tests+  ]
+ Tests/OffSystemAdd.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE TypeFamilies, NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Tests.OffSystemAdd where++import Data.Metrology.Poly+import Data.Metrology.SI+import qualified Data.Metrology.SI.Dims as D++import Test.Tasty+import Test.Tasty.HUnit+import Test.HUnit.Approx++data Foot = Foot+instance Unit Foot where+  type BaseUnit Foot = Meter+  conversionRatio _ = 0.3048++data Year = Year+instance Unit Year where+  type BaseUnit Year = Second+  conversionRatio _ = 60 * 60 * 24 * 365.242++vel1 :: Velocity+vel1 = 1e6 % (Foot :/ Year)++vel2 :: Velocity+vel2 = 0.01 % (Meter :/ Second)+++vel1InMS :: Double+vel1InMS = vel1 # (Meter :/ Second)++vel2InMS :: Double+vel2InMS = vel2 # (Meter :/ Second)++vel12InMS :: Double+vel12InMS = (vel1 |+| vel2) # (Meter :/ Second)+++len1 :: Length+len1 = 3 % Foot++len2 :: Length+len2 = 1 % Meter++len12InM :: Double+len12InM = (len1 |+| len2) # Meter++type instance DefaultUnitOfDim D.Length = Meter++-- The following expression does typecheck,+-- because the system is now able to work in defaultLCSU mode+-- that only requires relative relation between units.+len12InM' :: Double+len12InM' = (defaultLCSU $ (1 % Meter) |+| (3 % Foot)) # Meter++tests = testGroup "OffSystemAdd"+  [ testCase "vel1inMS" (vel1InMS @?~ 0.00965873546)+  , testCase "vel2inMS" (vel2InMS @?~ 0.01)+  , testCase "vel12inMS" (vel12InMS @?~ 0.01965873)+  , testCase "len12InM" (len12InM @?~ 1.9144) ]
+ Tests/OffSystemCSU.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE TypeOperators, DataKinds, TypeFamilies, NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Tests.OffSystemCSU where++import Data.Metrology.Poly+import Data.Metrology.SI+import qualified Data.Metrology.SI.Dims as D++import Test.Tasty.HUnit+import Test.HUnit.Approx++type YardPond = MkLCSU '[ (D.Length, Foot)]++type LengthYP = MkQu_DLN D.Length YardPond Double++data Foot = Foot+instance Unit Foot where+  type BaseUnit Foot = Meter+  conversionRatio _ = 0.3048++data Year = Year+instance Unit Year where+  type BaseUnit Year = Second+  conversionRatio _ = 60 * 60 * 24 * 365.242++len1 :: LengthYP+len1 = 3 % Foot ++len2 :: LengthYP+len2 = 1 % Meter++x :: Double+x = (len1 |+| len2) # Meter++tests = testCase "OffSystemCSU" (x @?~ 1.9144)
+ Tests/Parser.hs view
@@ -0,0 +1,214 @@+{- Test the unit parser+   Copyright (c) 2014 Richard Eisenberg+-}++{-# LANGUAGE TemplateHaskell #-}++module Tests.Parser where++import Prelude hiding ( lex, exp )++import Data.Metrology.Parser+import Data.Metrology.Parser.Internal+import Data.Metrology.SI++import Control.Monad.Reader+import qualified Data.Map.Strict as Map+import Text.Parsec+import Language.Haskell.TH+import Data.Generics++import Test.Tasty+import Test.Tasty.HUnit++leftOnly :: Either a b -> Maybe a+leftOnly (Left a) = Just a+leftOnly (Right _) = Nothing++----------------------------------------------------------------------+-- TH functions+----------------------------------------------------------------------++stripModules :: Data a => a -> a+stripModules = everywhere (mkT (mkName . nameBase))++pprintUnqualified :: (Ppr a, Data a) => a -> String+pprintUnqualified = pprint . stripModules++----------------------------------------------------------------------+-- Lexer+----------------------------------------------------------------------++lexTest :: String -> String+lexTest s =+  case lex s of+    Left _     -> "error"+    Right toks -> show toks++lexTestCases :: [(String, String)]+lexTestCases = [ ( "m", "[m]" )+               , ( "", "[]" )+               , ( "m s", "[m,s]" )+               , ( "   m   s ", "[m,s]" )+               , ( "m   ", "[m]" )+               , ( "   m", "[m]" )+               , ( "( m  /s", "[(,m,/,s]" )+               , ( "!", "error" )+               , ( "1 2 3", "[1,2,3]" )+               , ( "  ", "[]" )+               ]++lexTests :: TestTree+lexTests = testGroup "Lexer" $+  map (\(str, out) -> testCase ("`" ++ str ++ "'") $ lexTest str @?= out) lexTestCases++----------------------------------------------------------------------+-- Unit strings+----------------------------------------------------------------------++unitStringTestCases :: [(String, String)]+unitStringTestCases = [ ("m", "Meter")+                      , ("s", "Second")+                      , ("min", "Minute")+                      , ("km", "Kilo :@ Meter")+                      , ("mm", "Milli :@ Meter")+                      , ("kmin", "Kilo :@ Minute")+                      , ("dam", "error")   -- ambiguous!+                      , ("damin", "Deca :@ Minute")+                      , ("ms", "Milli :@ Second")+                      , ("mmin", "Milli :@ Minute")+                      , ("mmm", "error")+                      , ("mmmin", "error")+                      , ("sm", "error")+                      , ("", "error")+                      , ("dak", "error")+                      , ("das", "Deca :@ Second")+                      , ("ds", "Deci :@ Second")+                      , ("daam", "Deca :@ Ampere")+                      , ("kam", "Kilo :@ Ampere")+                      , ("dm", "Deci :@ Meter")+                      ]++parseUnitStringTest :: String -> String+parseUnitStringTest s =+  case flip runReader testSymbolTable $ runParserT unitStringParser () "" s of+    Left _ -> "error"+    Right exp -> show exp++unitStringTests :: TestTree+unitStringTests = testGroup "UnitStrings" $+  map (\(str, out) -> testCase ("`" ++ str ++ "'") $ parseUnitStringTest str @?= out)+    unitStringTestCases++----------------------------------------------------------------------+-- Symbol tables+----------------------------------------------------------------------++mkSymbolTableTests :: TestTree+mkSymbolTableTests = testGroup "mkSymbolTable"+  [ testCase "Unambiguous1" (Map.keys (prefixTable testSymbolTable) @?= ["d","da","k","m"])+  , testCase "Unambiguous2" (Map.keys (unitTable testSymbolTable) @?= ["am","m","min","s"])+  , testCase "AmbigPrefix" (leftOnly (mkSymbolTable [("a",''Milli),("a",''Centi)] ([] :: [(String,Name)])) @?= Just "The label `a' is assigned to the following meanings:\n[\"Data.Metrology.SI.Prefixes.Milli\",\"Data.Metrology.SI.Prefixes.Centi\"]\nThis is ambiguous. Please fix before building a unit parser.")+  , testCase "AmbigUnit" (leftOnly (mkSymbolTable ([] :: [(String,Name)]) [("m",''Meter),("m",''Minute)]) @?= Just "The label `m' is assigned to the following meanings:\n[\"Data.Metrology.SI.Units.Meter\",\"Data.Metrology.SI.Units.Minute\"]\nThis is ambiguous. Please fix before building a unit parser.")+  , testCase "MultiAmbig" (leftOnly (mkSymbolTable [("a",''Milli),("b",''Centi),("b",''Deci),("b",''Kilo),("c",''Atto),("c",''Deca)] [("m",''Meter),("m",''Minute),("s",''Second)]) @?= Just "The label `b' is assigned to the following meanings:\n[\"Data.Metrology.SI.Prefixes.Centi\",\"Data.Metrology.SI.Prefixes.Deci\",\"Data.Metrology.SI.Prefixes.Kilo\"]\nThe label `c' is assigned to the following meanings:\n[\"Data.Metrology.SI.Prefixes.Atto\",\"Data.Metrology.SI.Prefixes.Deca\"]\nThis is ambiguous. Please fix before building a unit parser.")+                                                                                                ]++testSymbolTable :: SymbolTable Name Name+Right testSymbolTable =+   mkSymbolTable (stripModules [ ("k", ''Kilo)+                               , ("da", ''Deca)+                               , ("m", ''Milli)+                               , ("d", ''Deci) ])+                 (stripModules [ ("m", ''Meter)+                               , ("s", ''Second)+                               , ("min", ''Minute)+                               , ("am", ''Ampere) ])++----------------------------------------------------------------------+-- Overall parser+----------------------------------------------------------------------++parseUnitTest :: String -> String+parseUnitTest s =+  case parseUnitExp testSymbolTable s of+    Left _    -> "error"+    Right exp -> pprintUnqualified exp++parseTestCases :: [(String, String)]+parseTestCases =+  [ ("m", "undefined :: Meter")+  , ("s", "undefined :: Second")+  , ("ms", "(:@) (undefined :: Milli) (undefined :: Second)")+  , ("mm", "(:@) (undefined :: Milli) (undefined :: Meter)")+  , ("mmm", "error")+  , ("km", "(:@) (undefined :: Kilo) (undefined :: Meter)")+  , ("m s", "(:*) (undefined :: Meter) (undefined :: Second)")+  , ("m/s", "(:/) (undefined :: Meter) (undefined :: Second)")+  , ("m/s^2", "(:/) (undefined :: Meter) ((:^) (undefined :: Second) (sSucc (sSucc sZero)))")+  , ("s/m m", "(:/) (undefined :: Second) ((:*) (undefined :: Meter) (undefined :: Meter))")+  , ("s s/m m", "(:/) ((:*) (undefined :: Second) (undefined :: Second)) ((:*) (undefined :: Meter) (undefined :: Meter))")+  , ("s*s/m*m", "(:*) ((:/) ((:*) (undefined :: Second) (undefined :: Second)) (undefined :: Meter)) (undefined :: Meter)")+  , ("s*s/(m*m)", "(:/) ((:*) (undefined :: Second) (undefined :: Second)) ((:*) (undefined :: Meter) (undefined :: Meter))")+  , ("m^-1", "(:^) (undefined :: Meter) (sPred sZero)")+  , ("m^(-1)", "(:^) (undefined :: Meter) (sPred sZero)")+  , ("m^(-(1))", "(:^) (undefined :: Meter) (sPred sZero)")+  , ("1", "Number")+  , ("1/s", "(:/) Number (undefined :: Second)")+  , ("m 1 m", "(:*) ((:*) (undefined :: Meter) Number) (undefined :: Meter)")+  , ("  ", "Number")+  , ("", "Number")+  ]++parseUnitTests :: TestTree+parseUnitTests = testGroup "ParseUnit" $+  map (\(str, out) -> testCase ("`" ++ str ++ "'") $ parseUnitTest str @?= out)+    parseTestCases++parseUnitTestT :: String -> String+parseUnitTestT s =+  case parseUnitType testSymbolTable s of+    Left _    -> "error"+    Right exp -> pprintUnqualified exp++parseTestCasesT :: [(String, String)]+parseTestCasesT =+  [ ("m", "Meter")+  , ("s", "Second")+  , ("ms", ":@ Milli Second")+  , ("mm", ":@ Milli Meter")+  , ("mmm", "error")+  , ("km", ":@ Kilo Meter")+  , ("m s", ":* Meter Second")+  , ("m/s", ":/ Meter Second")+  , ("m/s^2", ":/ Meter (:^ Second (Succ (Succ Zero)))")+  , ("s/m m", ":/ Second (:* Meter Meter)")+  , ("s s/m m", ":/ (:* Second Second) (:* Meter Meter)")+  , ("s*s/m*m", ":* (:/ (:* Second Second) Meter) Meter")+  , ("s*s/(m*m)", ":/ (:* Second Second) (:* Meter Meter)")+  , ("m^-1", ":^ Meter (Pred Zero)")+  , ("m^(-1)", ":^ Meter (Pred Zero)")+  , ("m^(-(1))", ":^ Meter (Pred Zero)")+  , ("1", "Number")+  , ("1/s", ":/ Number Second")+  , ("m 1 m", ":* (:* Meter Number) Meter")+  , ("  ", "Number")+  , ("", "Number")+  ]++parseUnitTestsT :: TestTree+parseUnitTestsT = testGroup "ParseUnitType" $+  map (\(str, out) -> testCase ("`" ++ str ++ "'") $ parseUnitTestT str @?= out)+    parseTestCasesT++----------------------------------------------------------------------+-- Conclusion+----------------------------------------------------------------------++tests :: TestTree+tests = testGroup "Parser"+  [ lexTests+  , mkSymbolTableTests+  , unitStringTests+  , parseUnitTests+  , parseUnitTestsT+  ]
+ Tests/PhysicalConstants.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, TypeFamilies,+             TypeOperators, ImplicitParams #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Tests.PhysicalConstants where++import Data.Metrology.Poly+import Data.Metrology.Show ()+import Data.Metrology.SI.Poly+import qualified Data.Metrology.SI.Dims as D++import Tests.Compile.MetrologySynonyms++import Test.Tasty.HUnit+import Test.HUnit.Approx++----------------------------------------------------------------+-- Mass units+----------------------------------------------------------------++type instance DefaultUnitOfDim D.Mass = Kilo :@ Gram+type instance DefaultUnitOfDim D.Time = Second+type instance DefaultUnitOfDim D.Length = Meter+type instance DefaultUnitOfDim D.Current = Ampere+type instance DefaultUnitOfDim D.Temperature = Kelvin++-- | A unicornhorn of honor (unicornhorn in short) is the historical+-- unit of length used in Kingdom of Fantasia. A unicornhorn was+-- defined as the length of the horn of the King's honored+-- unicorn. Unfortunately, king's men did not documented their+-- technology, so today there's no telling how long a unicornhorn was.++data UnicornHorn = UnicornHorn+instance Unit UnicornHorn where+  type BaseUnit UnicornHorn = Canonical+  type DimOfUnit UnicornHorn = D.Length+instance Show UnicornHorn where+  show _ = "uhoh"++type MkQu_UL unit lcsu = MkQu_ULN unit lcsu Double++type KingdomUnit = MkLCSU '[ (D.Length, UnicornHorn) ]++solarMass :: DefaultConvertibleLCSU_D D.Mass l => Mass l Double+solarMass = constant $ 1.98892e33 % Gram++earthMass :: DefaultConvertibleLCSU_D D.Mass l => Mass l Double+earthMass = constant $ 5.9742e24 % Gram++electronMass :: DefaultConvertibleLCSU_D D.Mass l => Mass l Double+electronMass = constant $ 9.10938291e-28 % Gram++protonMass :: DefaultConvertibleLCSU_D D.Mass l => Mass l Double+protonMass = constant $ 1.67262178e-24 % Gram++speedOfLight :: DefaultConvertibleLCSU_D D.Velocity l => Velocity l Double+speedOfLight =  constant $ 299792458 % ((Second :^ sMOne) :* Meter)++elementaryCharge :: DefaultConvertibleLCSU_D D.Charge l => Charge l Double+elementaryCharge = constant $ 1.60217657e-19 % Coulomb++gravitationalConstant :: DefaultConvertibleLCSU_U SIGCUnit l => MkQu_UL SIGCUnit l+gravitationalConstant = constant $ 6.67384e-11 % (undefined :: SIGCUnit)++kB :: DefaultConvertibleLCSU_U SIkBUnit l => MkQu_UL SIkBUnit l+kB = constant $ 1.3806488e-23 % (undefined :: SIkBUnit)++-- RAE: problem solved. :)+planckLength :: DefaultConvertibleLCSU_D D.Length l => Length l Double+planckLength = constant $ qSqrt (hbar |*| gravitationalConstant |/| (speedOfLight |^ sThree))++planckTime :: DefaultConvertibleLCSU_D D.Time l => Time l Double+planckTime = constant $ planckLength |/| speedOfLight++-- eps0+vacuumPermittivity :: CompatibleUnit l SIPermittivityUnit+  => MkQu_UL SIPermittivityUnit l+vacuumPermittivity =  +  (1 / (4 * pi * 1e-7 * 299792458**2)) % (undefined :: SIPermittivityUnit)+-- mu0                     +vacuumPermeability :: CompatibleUnit l SIPermeabilityUnit +  => MkQu_UL SIPermeabilityUnit l+vacuumPermeability = (4 * pi * 1e-7) % (undefined :: SIPermeabilityUnit)++-- |Planck constant+planckConstant :: CompatibleUnit l JouleSecond +  => MkQu_UL JouleSecond l+planckConstant =  (6.6260695729e-34) % (undefined :: JouleSecond)++-- |Reduced Planck constant+hbar ::  CompatibleUnit l JouleSecond   => MkQu_UL JouleSecond l+hbar = (1 / 2 / pi) *| planckConstant++tests =+  let ?epsilon = 1e-40 in+  testCase "PhysicalConstants" ((planckLength :: Length SI Double) # Meter @?~ 1.616199e-35)++main :: IO ()+main = do+  putStrLn "typechecks!"+  print (planckLength :: Length SI Double)+--  print (planckLength :: Length KingdomUnit Double)+-- last line does not typecheck -- good!++{- output --++typechecks!+1.616199256057012e-35 m++-}++
+ Tests/Show.hs view
@@ -0,0 +1,24 @@+{- Test Show instances+   Copyright (c) 2014 Richard Eisenberg+-}++module Tests.Show where++import Data.Metrology+import Data.Metrology.Show ()+import Data.Metrology.SI++import Test.Tasty+import Test.Tasty.HUnit++five :: Double+five = 5++tests :: TestTree+tests = testGroup "Show"+  [ testCase "Meter" $ show (five % Meter) @?= "5.0 m"+  , testCase "Meter/Second" $ show (five % (Meter :/ Second)) @?= "5.0 m/s"+  , testCase "Meter/Second2" $ show (five % (Number :* Second :* Meter :/ (Second :^ sTwo))) @?= "5.0 m/s"+  , testCase "Hertz" $ show (five % Hertz) @?= "5.0 s^-1"+  , testCase "Joule" $ show (five % Joule) @?= "5.0 (kg * m^2)/s^2"+  ]
+ Tests/Travel.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ImplicitParams #-}++module Tests.Travel where++import Data.Metrology.Poly+import Data.Metrology.SI.Poly+import Data.Metrology.Imperial.Types (Imperial)+import Data.Metrology.Imperial.Units+import Data.Metrology.Show ()+import qualified Data.Metrology.SI.Dims as D++import Test.Tasty+import Test.Tasty.HUnit+import Test.HUnit.Approx++type PerArea lcsu n = MkQu_DLN (D.Area :^ MOne) lcsu n++fromGLtoED :: MkQu_DLN D.Length Imperial Float+fromGLtoED = 46.5 % Mile++fuelEfficiency :: PerArea Imperial Float+fuelEfficiency = 40 % (Mile :/ Gallon)++gasolineDensity :: MkQu_DLN D.Density Imperial Float+gasolineDensity = 7.29 % (Pound :/ Gallon)++gasolineWeight :: (Fractional f) +  => MkQu_DLN D.Length su f -> PerArea su f -> MkQu_DLN D.Density su f -> MkQu_DLN D.Mass su f+gasolineWeight len0 ef0 den0 = len0 |/| ef0 |*| den0++tests :: TestTree+tests =+  let ?epsilon = 0.00001 in+  testGroup "Travel"+  [ testCase "fromGLtoED" (fromGLtoED # Mile @?~ 46.5)+  , testCase "fuelEfficiency" (fuelEfficiency # (Mile :/ Gallon) @?~ 39.999996)+  , testCase "gasolineDensity" (gasolineDensity # (Pound :/ Gallon) @?~ 7.29)+  , testCase "gasolineWeight" (gasolineWeight fromGLtoED fuelEfficiency gasolineDensity # Pound @?~ 8.474626)+  , testCase "fromGLtoED2" (fromGLtoED # kilo Meter @?~ 74.834496)+  , testCase "fuelEfficiency2" (fuelEfficiency # (kilo Meter :/ Liter) @?~ 14.160248)+  , testCase "gasolineDensity2" (gasolineDensity # (kilo Gram :/ Liter) @?~ 0.7273698)+  , testCase "gasolineWeight2" ((gasolineWeight (convert fromGLtoED) (convert fuelEfficiency) (convert gasolineDensity) :: MkQu_DLN D.Mass SI Float) # kilo Gram @?~ 3.8440251) ]++main :: IO ()+main = do+  putStrLn $ fromGLtoED `showIn` Mile+  putStrLn $ fuelEfficiency `showIn` Mile :/ Gallon+  putStrLn $ gasolineDensity `showIn` Pound :/ Gallon+  putStrLn $ show $ gasolineWeight fromGLtoED fuelEfficiency gasolineDensity ++  putStrLn ""+  putStrLn $ fromGLtoED `showIn` (kilo Meter)+  putStrLn $ fuelEfficiency `showIn`  kilo Meter :/ Liter+  putStrLn $ gasolineDensity `showIn` kilo Gram :/ Liter+  putStrLn $ show $ (gasolineWeight +    (convert fromGLtoED) (convert fuelEfficiency) (convert gasolineDensity) :: MkQu_DLN D.Mass SI Float)+++{---- Execution result ---+46.5 mi+39.999996 mi/gal+7.29 lb/gal+8.474626 lb++74.834496 km+14.160248 km/l+0.7273698 kg/l+3.8440251 kg+-}
+ units-defs/Data/Metrology/Imperial/Types.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TypeOperators, DataKinds #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.Imperial.Types+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module defines type synonyms for British Imperial units.+-----------------------------------------------------------------------------+module Data.Metrology.Imperial.Types where++import Data.Metrology+import Data.Metrology.SI.Units+import Data.Metrology.Imperial.Units (Yard, Pound)+import qualified Data.Metrology.SI.Dims as D+++type Imperial = +  MkLCSU +   '[ (D.Length, Yard)+    , (D.Mass, Pound)+    , (D.Time, Second)+    , (D.Current, Ampere)+    , (D.Temperature, Kelvin)+    , (D.AmountOfSubstance, Mole)+    , (D.LuminousIntensity, Candela)+    ]++type Length              = MkQu_DLN D.Length              Imperial Double+type Mass                = MkQu_DLN D.Mass                Imperial Double+type Time                = MkQu_DLN D.Time                Imperial Double+type Current             = MkQu_DLN D.Current             Imperial Double+type Temperature         = MkQu_DLN D.Temperature         Imperial Double+type AmountOfSubstance   = MkQu_DLN D.AmountOfSubstance   Imperial Double+type LuminousIntensity   = MkQu_DLN D.LuminousIntensity   Imperial Double++type Area                = MkQu_DLN D.Area                Imperial Double+type Volume              = MkQu_DLN D.Volume              Imperial Double+type Velocity            = MkQu_DLN D.Velocity            Imperial Double+type Acceleration        = MkQu_DLN D.Acceleration        Imperial Double+type Wavenumber          = MkQu_DLN D.Wavenumber          Imperial Double+type Density             = MkQu_DLN D.Density             Imperial Double+type SurfaceDensity      = MkQu_DLN D.SurfaceDensity      Imperial Double+type SpecificVolume      = MkQu_DLN D.SpecificVolume      Imperial Double+type CurrentDensity      = MkQu_DLN D.CurrentDensity      Imperial Double+type MagneticStrength    = MkQu_DLN D.MagneticStrength    Imperial Double+type Concentration       = MkQu_DLN D.Concentration       Imperial Double+type Luminance           = MkQu_DLN D.Luminance           Imperial Double+type Frequency           = MkQu_DLN D.Frequency           Imperial Double+type Force               = MkQu_DLN D.Force               Imperial Double+type Pressure            = MkQu_DLN D.Pressure            Imperial Double+type Energy              = MkQu_DLN D.Energy              Imperial Double+type Power               = MkQu_DLN D.Power               Imperial Double+type Charge              = MkQu_DLN D.Charge              Imperial Double+type ElectricPotential   = MkQu_DLN D.ElectricPotential   Imperial Double+type Capacitance         = MkQu_DLN D.Capacitance         Imperial Double+type Resistance          = MkQu_DLN D.Resistance          Imperial Double+type Conductance         = MkQu_DLN D.Conductance         Imperial Double+type MagneticFlux        = MkQu_DLN D.MagneticFlux        Imperial Double+type MagneticFluxDensity = MkQu_DLN D.MagneticFluxDensity Imperial Double+type Inductance          = MkQu_DLN D.Inductance          Imperial Double+type Illuminance         = MkQu_DLN D.Illuminance         Imperial Double+type Kerma               = MkQu_DLN D.Kerma               Imperial Double+type CatalyticActivity   = MkQu_DLN D.CatalyticActivity   Imperial Double+type Momentum            = MkQu_DLN D.Momentum            Imperial Double
+ units-defs/Data/Metrology/Imperial/Units.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.Imperial.Units+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module exports unit definitions according to the British Imperial system of units.+-- The definitions were taken from here: <http://en.wikipedia.org/wiki/Imperial_units>.+--+-----------------------------------------------------------------------------++module Data.Metrology.Imperial.Units where++import Data.Metrology+import Data.Metrology.SI.Units (Meter(..), Gram(..))++---------------------------------+-- Lengths+---------------------------------++data Thou = Thou+instance Unit Thou where+  type BaseUnit Thou = Inch+  conversionRatio _ = 1/1000+instance Show Thou where+  show _ = "th"++data Inch = Inch+instance Unit Inch where+  type BaseUnit Inch = Foot+  conversionRatio _ = 1/12+instance Show Inch where+  show _ = "in"++data Foot = Foot+instance Unit Foot where+  type BaseUnit Foot = Yard+  conversionRatio _ = 1/3+instance Show Foot where+  show _ = "ft"++data Yard = Yard+instance Unit Yard where+  type BaseUnit Yard = Meter+  conversionRatio _ = 0.9144+instance Show Yard where+  show _ = "yd"++data Chain = Chain+instance Unit Chain where+  type BaseUnit Chain = Yard+  conversionRatio _ = 22+instance Show Chain where+  show _ = "ch"++data Furlong = Furlong+instance Unit Furlong where+  type BaseUnit Furlong = Chain+  conversionRatio _ = 10+instance Show Furlong where+  show _ = "fur"++data Mile = Mile+instance Unit Mile where+  type BaseUnit Mile = Furlong+  conversionRatio _ = 8+instance Show Mile where+  show _ = "mi"++data League = League+instance Unit League where+  type BaseUnit League = Mile+  conversionRatio _ = 3+instance Show League where+  show _ = "lea"++---------------------------------+-- Volumes+---------------------------------++data Gallon = Gallon+instance Unit Gallon where+  type BaseUnit Gallon = (Meter :^ Three)+  conversionRatio _ = 0.00454609+instance Show Gallon where+  show _ = "gal"++---------------------------------+-- Weights+---------------------------------++data Ounce = Ounce+instance Unit Ounce where+  type BaseUnit Ounce = Pound+  conversionRatio _ = 1/16+instance Show Ounce where+  show _ = "oz"++data Pound = Pound+instance Unit Pound where+  type BaseUnit Pound = Gram+  conversionRatio _ = 453.59237    -- on Earth, at least!+instance Show Pound where+  show _ = "lb"+++
+ units-defs/Data/Metrology/SI.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module exports unit, type, and prefix definitions according to the SI+-- system of units. The definitions were taken from here:+-- <http://www.bipm.org/en/si/> and here:+-- <http://www.bipm.org/utils/common/documents/jcgm/JCGM_200_2012.pdf>.+--+-- This module exports the monomorphic version of the definitions. For+-- polymorphic versions, use 'Data.Metrology.SI.Poly'.+-----------------------------------------------------------------------------++module Data.Metrology.SI (+  module Data.Metrology.SI.Mono+  ) where++import Data.Metrology.SI.Mono++
+ units-defs/Data/Metrology/SI/Dims.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI.Dims+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module defines SI dimensions. The names of SI dimensions conform to+-- <http://www.bipm.org/utils/common/documents/jcgm/JCGM_200_2012.pdf>.+-----------------------------------------------------------------------------++module Data.Metrology.SI.Dims where++import Data.Metrology++data Length = Length+instance Dimension Length++data Mass = Mass+instance Dimension Mass++data Time = Time+instance Dimension Time++data Current = Current+instance Dimension Current++data Temperature = Temperature+instance Dimension Temperature++data AmountOfSubstance = AmountOfSubstance+instance Dimension AmountOfSubstance++data LuminousIntensity = LuminousIntensity+instance Dimension LuminousIntensity++type Area                = Length            :^ Two+type Volume              = Length            :^ Three+type Velocity            = Length            :/ Time+type Acceleration        = Velocity          :/ Time+type Wavenumber          = Length            :^ MOne+type Density             = Mass              :/ Volume+type SurfaceDensity      = Mass              :/ Area+type SpecificVolume      = Volume            :/ Mass+type CurrentDensity      = Current           :/ Area+type MagneticStrength    = Current           :/ Length+type Concentration       = AmountOfSubstance          :/ Volume+type Luminance           = LuminousIntensity        :/ Area++type Frequency           = Time              :^ MOne+type Force               = Mass              :* Acceleration+type Pressure            = Force             :/ Area+type Energy              = Force             :* Length+type Power               = Energy            :/ Time+type Charge              = Current           :* Time+type ElectricPotential   = Power             :/ Current+type Capacitance         = Charge            :/ ElectricPotential+type Resistance          = ElectricPotential :/ Current+type Conductance         = Current           :/ ElectricPotential+type MagneticFlux        = ElectricPotential :* Time+type MagneticFluxDensity = MagneticFlux      :/ Area+type Inductance          = MagneticFlux      :/ Current+type LuminousFlux        = LuminousIntensity+type Illuminance         = LuminousIntensity :/ Area+type Kerma               = Area              :/ (Time :^ Two)+type CatalyticActivity   = AmountOfSubstance :/ Time++type Momentum            = Mass              :* Velocity
+ units-defs/Data/Metrology/SI/Mono.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TypeOperators, TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI.Mono+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module exports definitions for the SI system, with the intent+-- of using these definitions in a monomorphic manner -- that is,+-- with the DefaultLCSU.+-----------------------------------------------------------------------------++module Data.Metrology.SI.Mono (+  module Data.Metrology.SI.MonoTypes,+  module Data.Metrology.SI.Units,+  module Data.Metrology.SI.Prefixes,+  module Data.Metrology.SI.Parser+  ) where++import Data.Metrology.SI.MonoTypes+import Data.Metrology.SI.Units+import Data.Metrology.SI.Prefixes+import qualified Data.Metrology.SI.Dims as D+import Data.Metrology+import Data.Metrology.SI.Parser++type instance DefaultUnitOfDim D.Length            = Meter+type instance DefaultUnitOfDim D.Mass              = Kilo :@ Gram+type instance DefaultUnitOfDim D.Time              = Second+type instance DefaultUnitOfDim D.Current           = Ampere+type instance DefaultUnitOfDim D.Temperature       = Kelvin+type instance DefaultUnitOfDim D.AmountOfSubstance = Mole+type instance DefaultUnitOfDim D.LuminousIntensity = Lumen
+ units-defs/Data/Metrology/SI/MonoTypes.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE TypeFamilies, TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI.MonoTypes+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module defines type synonyms for SI units, using a Double as the+-- internal representation.+-----------------------------------------------------------------------------++module Data.Metrology.SI.MonoTypes where++import Data.Metrology+import qualified Data.Metrology.SI.Dims as D++type Length              = MkQu_D D.Length+type Mass                = MkQu_D D.Mass+type Time                = MkQu_D D.Time+type Current             = MkQu_D D.Current+type Temperature         = MkQu_D D.Temperature+type AmountOfSubstance   = MkQu_D D.AmountOfSubstance+type LuminousIntensity   = MkQu_D D.LuminousIntensity++type Area                = MkQu_D D.Area+type Volume              = MkQu_D D.Volume+type Velocity            = MkQu_D D.Velocity+type Acceleration        = MkQu_D D.Acceleration+type Wavenumber          = MkQu_D D.Wavenumber+type Density             = MkQu_D D.Density+type SurfaceDensity      = MkQu_D D.SurfaceDensity+type SpecificVolume      = MkQu_D D.SpecificVolume+type CurrentDensity      = MkQu_D D.CurrentDensity+type MagneticStrength    = MkQu_D D.MagneticStrength+type Concentration       = MkQu_D D.Concentration+type Luminance           = MkQu_D D.Luminance+type Frequency           = MkQu_D D.Frequency+type Force               = MkQu_D D.Force+type Pressure            = MkQu_D D.Pressure+type Energy              = MkQu_D D.Energy+type Power               = MkQu_D D.Power+type Charge              = MkQu_D D.Charge+type ElectricPotential   = MkQu_D D.ElectricPotential+type Capacitance         = MkQu_D D.Capacitance+type Resistance          = MkQu_D D.Resistance+type Conductance         = MkQu_D D.Conductance+type MagneticFlux        = MkQu_D D.MagneticFlux+type MagneticFluxDensity = MkQu_D D.MagneticFluxDensity+type Inductance          = MkQu_D D.Inductance+type LuminousFlux        = MkQu_D D.LuminousFlux+type Illuminance         = MkQu_D D.Illuminance+type Kerma               = MkQu_D D.Kerma+type CatalyticActivity   = MkQu_D D.CatalyticActivity+type Momentum            = MkQu_D D.Momentum
+ units-defs/Data/Metrology/SI/Parser.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI.Parser+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Defines a quasi-quoting parser for unit expressions. Writing, say,+-- @[si| m/s^2 |]@ produces @(Meter :/ (Second :^ sTwo))@. A larger+-- example is+--+-- > ke :: Energy+-- > ke = 5 % [si| N km |]  -- 5 Newton-kilometers+--+-- See `Data.Metrology.Parser` for more information about the syntax+-- of these unit expressions.+-----------------------------------------------------------------------------++module Data.Metrology.SI.Parser where++import Data.Metrology.Parser+import Data.Metrology.SI.Prefixes+import Data.Metrology.SI.Units++makeQuasiQuoter "si" siPrefixes siUnits
+ units-defs/Data/Metrology/SI/Poly.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TypeOperators, DataKinds #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI.Poly+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module exports definitions for the SI system, with the intent+-- of using these definitions in a polymorphic manner -- that is,+-- with multiple LCSUs.+-----------------------------------------------------------------------------++module Data.Metrology.SI.Poly (+  SI,+  module Data.Metrology.SI.PolyTypes,+  module Data.Metrology.SI.Prefixes,+  module Data.Metrology.SI.Units,+  module Data.Metrology.SI.Parser+  ) where++import Data.Metrology.SI.PolyTypes+import Data.Metrology.SI.Prefixes+import Data.Metrology.SI.Units+import qualified Data.Metrology.SI.Dims as D+import Data.Metrology+import Data.Metrology.SI.Parser++type SI = MkLCSU '[ (D.Length, Meter)+                  , (D.Mass, Kilo :@ Gram)+                  , (D.Time, Second)+                  , (D.Current, Ampere)+                  , (D.Temperature, Kelvin)+                  , (D.AmountOfSubstance, Mole)+                  , (D.LuminousIntensity, Lumen)+                  ]
+ units-defs/Data/Metrology/SI/PolyTypes.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE TypeOperators, DataKinds #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI.PolyTypes+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module defines type synonyms for dimensions based on the seven+-- SI dimensions, for arbitrary choice of system of units and numerical values.+-----------------------------------------------------------------------------++module Data.Metrology.SI.PolyTypes where++import Data.Metrology+import qualified Data.Metrology.SI.Dims as D++type Length              = MkQu_DLN D.Length              +type Mass                = MkQu_DLN D.Mass                +type Time                = MkQu_DLN D.Time                +type Current             = MkQu_DLN D.Current             +type Temperature         = MkQu_DLN D.Temperature         +type AmountOfSubstance   = MkQu_DLN D.AmountOfSubstance   +type LuminousIntensity   = MkQu_DLN D.LuminousIntensity   ++type Area                = MkQu_DLN D.Area                +type Volume              = MkQu_DLN D.Volume              +type Velocity            = MkQu_DLN D.Velocity            +type Acceleration        = MkQu_DLN D.Acceleration        +type Wavenumber          = MkQu_DLN D.Wavenumber          +type Density             = MkQu_DLN D.Density             +type SurfaceDensity      = MkQu_DLN D.SurfaceDensity      +type SpecificVolume      = MkQu_DLN D.SpecificVolume      +type CurrentDensity      = MkQu_DLN D.CurrentDensity      +type MagneticStrength    = MkQu_DLN D.MagneticStrength    +type Concentration       = MkQu_DLN D.Concentration       +type Luminance           = MkQu_DLN D.Luminance           +type Frequency           = MkQu_DLN D.Frequency           +type Force               = MkQu_DLN D.Force               +type Pressure            = MkQu_DLN D.Pressure            +type Energy              = MkQu_DLN D.Energy              +type Power               = MkQu_DLN D.Power               +type Charge              = MkQu_DLN D.Charge              +type ElectricPotential   = MkQu_DLN D.ElectricPotential   +type Capacitance         = MkQu_DLN D.Capacitance         +type Resistance          = MkQu_DLN D.Resistance          +type Conductance         = MkQu_DLN D.Conductance         +type MagneticFlux        = MkQu_DLN D.MagneticFlux        +type MagneticFluxDensity = MkQu_DLN D.MagneticFluxDensity +type Inductance          = MkQu_DLN D.Inductance          +type LuminousFlux        = MkQu_DLN D.LuminousFlux        +type Illuminance         = MkQu_DLN D.Illuminance         +type Kerma               = MkQu_DLN D.Kerma               +type CatalyticActivity   = MkQu_DLN D.CatalyticActivity   +type Momentum            = MkQu_DLN D.Momentum
+ units-defs/Data/Metrology/SI/Prefixes.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE TypeOperators, TemplateHaskell #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI.Prefixes+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Defines prefixes from the SI standard at <http://www.bipm.org/en/si/>+-----------------------------------------------------------------------------++module Data.Metrology.SI.Prefixes where++import Language.Haskell.TH ( Name )+import Data.Metrology++-- | 10^1+data Deca = Deca+instance UnitPrefix Deca where+  multiplier _ = 1e1+instance Show Deca where+  show _ = "da"++deca :: unit -> Deca :@ unit+deca = (Deca :@)++-- | 10^2+data Hecto = Hecto+instance UnitPrefix Hecto where+  multiplier _ = 1e2+instance Show Hecto where+  show _ = "h"++hecto :: unit -> Hecto :@ unit+hecto = (Hecto :@)++-- | 10^3+data Kilo = Kilo+instance UnitPrefix Kilo where+  multiplier _ = 1e3+instance Show Kilo where+  show _ = "k"++kilo :: unit -> Kilo :@ unit+kilo = (Kilo :@)++-- | 10^6+data Mega = Mega+instance UnitPrefix Mega where+  multiplier _ = 1e6+instance Show Mega where+  show _ = "M"++mega :: unit -> Mega :@ unit+mega = (Mega :@)++-- | 10^9+data Giga = Giga+instance UnitPrefix Giga where+  multiplier _ = 1e9+instance Show Giga where+  show _ = "G"++giga :: unit -> Giga :@ unit+giga = (Giga :@)++-- | 10^12+data Tera = Tera+instance UnitPrefix Tera where+  multiplier _ = 1e12+instance Show Tera where+  show _ = "T"++tera :: unit -> Tera :@ unit+tera = (Tera :@)++-- | 10^15+data Peta = Peta+instance UnitPrefix Peta where+  multiplier _ = 1e15+instance Show Peta where+  show _ = "P"++peta :: unit -> Peta :@ unit+peta = (Peta :@)++-- | 10^18+data Exa = Exa+instance UnitPrefix Exa where+  multiplier _ = 1e18+instance Show Exa where+  show _ = "E"++exa :: unit -> Exa :@ unit+exa = (Exa :@)++-- | 10^21+data Zetta = Zetta+instance UnitPrefix Zetta where+  multiplier _ = 1e21+instance Show Zetta where+  show _ = "Z"++zetta :: unit -> Zetta :@ unit+zetta = (Zetta :@)++-- | 10^24+data Yotta = Yotta+instance UnitPrefix Yotta where+  multiplier _ = 1e24+instance Show Yotta where+  show _ = "Y"++yotta :: unit -> Yotta :@ unit+yotta = (Yotta :@)++-- | 10^-1+data Deci = Deci+instance UnitPrefix Deci where+  multiplier _ = 1e-1+instance Show Deci where+  show _ = "d"++deci :: unit -> Deci :@ unit+deci = (Deci :@)++-- | 10^-2+data Centi = Centi+instance UnitPrefix Centi where+  multiplier _ = 1e-2+instance Show Centi where+  show _ = "c"++centi :: unit -> Centi :@ unit+centi = (Centi :@)++-- | 10^-3+data Milli = Milli+instance UnitPrefix Milli where+  multiplier _ = 1e-3+instance Show Milli where+  show _ = "m"++milli :: unit -> Milli :@ unit+milli = (Milli :@)++-- | 10^-6+data Micro = Micro+instance UnitPrefix Micro where+  multiplier _ = 1e-6+instance Show Micro where+  show _ = "μ"++micro :: unit -> Micro :@ unit+micro = (Micro :@)++-- | 10^-9+data Nano = Nano+instance UnitPrefix Nano where+  multiplier _ = 1e-9+instance Show Nano where+  show _ = "n"++nano :: unit -> Nano :@ unit+nano = (Nano :@)++-- | 10^-12+data Pico = Pico+instance UnitPrefix Pico where+  multiplier _ = 1e-12+instance Show Pico where+  show _ = "p"++pico :: unit -> Pico :@ unit+pico = (Pico :@)++-- | 10^-15+data Femto = Femto+instance UnitPrefix Femto where+  multiplier _ = 1e-15+instance Show Femto where+  show _ = "f"++femto :: unit -> Femto :@ unit+femto = (Femto :@)++-- | 10^-18+data Atto = Atto+instance UnitPrefix Atto where+  multiplier _ = 1e-18+instance Show Atto where+  show _ = "a"++atto :: unit -> Atto :@ unit+atto = (Atto :@)++-- | 10^-21+data Zepto = Zepto+instance UnitPrefix Zepto where+  multiplier _ = 1e-21+instance Show Zepto where+  show _ = "z"++zepto :: unit -> Zepto :@ unit+zepto = (Zepto :@)++-- | 10^-24+data Yocto = Yocto+instance UnitPrefix Yocto where+  multiplier _ = 1e-24+instance Show Yocto where+  show _ = "y"++yocto :: unit -> Yocto :@ unit+yocto = (Yocto :@)++-- | A list of the names of all prefix types. Useful with+-- 'Data.Metrology.Parser.makeQuasiQuoter'.+siPrefixes :: [Name]+siPrefixes =+  [ ''Deca, ''Hecto, ''Kilo, ''Mega, ''Giga, ''Tera, ''Peta, ''Exa+  , ''Zetta, ''Yotta, ''Deci, ''Centi, ''Milli, ''Micro, ''Nano+  , ''Pico, ''Femto, ''Atto, ''Zepto, ''Yocto+  ]
+ units-defs/Data/Metrology/SI/Units.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE TypeFamilies, TypeOperators, PatternSynonyms, TemplateHaskell #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Metrology.SI.Units+-- Copyright   :  (C) 2013 Richard Eisenberg+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)+-- Stability   :  experimental+-- Portability :  non-portable+--+-- This module exports unit definitions according to the SI system of units.+-- The definitions were taken from here: <http://www.bipm.org/en/si/>.+--+-- Some additional units were added base on+-- <http://www.bipm.org/en/si/si_brochure/chapter4/table6.html this link>:+-- "Non-SI units accepted for use with the SI,+-- and units based on fundamental constants".+--+-- There is one deviation from the definition at that site: To work better+-- with prefixes, the unit of mass is 'Gram'.+--+-- This module exports both American spellings and British spellings of+-- units, using pattern synonyms to get the British spellings of data+-- constructors.+-----------------------------------------------------------------------------++module Data.Metrology.SI.Units where++import Data.Metrology+import Data.Metrology.SI.Dims+import Data.Metrology.SI.Prefixes ( Kilo, Centi )++import Language.Haskell.TH ( Name )++data Meter = Meter+instance Unit Meter where+  type BaseUnit Meter = Canonical+  type DimOfUnit Meter = Length+instance Show Meter where+  show _ = "m"++type Metre = Meter+pattern Metre = Meter++data Gram = Gram+instance Unit Gram where+  type BaseUnit Gram = Canonical+  type DimOfUnit Gram = Mass+instance Show Gram where+  show _ = "g"++data Second = Second+instance Unit Second where+  type BaseUnit Second = Canonical+  type DimOfUnit Second = Time+instance Show Second where+  show _ = "s"++-- | Derived SI unit+data Minute = Minute+instance Unit Minute where+  type BaseUnit Minute = Second+  conversionRatio _ = 60+instance Show Minute where+  show _ = "min"++-- | Derived SI unit+data Hour = Hour+instance Unit Hour where+  type BaseUnit Hour = Minute+  conversionRatio _ = 60+instance Show Hour where+  show _ = "h"++data Day = Day+instance Unit Day where+  type BaseUnit Day = Hour+  conversionRatio _ = 24+instance Show Day where+  show _ = "d"++data Ampere = Ampere+instance Unit Ampere where+  type BaseUnit Ampere = Canonical+  type DimOfUnit Ampere = Current+instance Show Ampere where+  show _ = "A"++data Kelvin = Kelvin+instance Unit Kelvin where+  type BaseUnit Kelvin = Canonical+  type DimOfUnit Kelvin = Temperature+instance Show Kelvin where+  show _ = "K"++data Mole = Mole+instance Unit Mole where+  type BaseUnit Mole = Canonical+  type DimOfUnit Mole = AmountOfSubstance+instance Show Mole where+  show _ = "mol"++data Candela = Candela+instance Unit Candela where+  type BaseUnit Candela = Canonical+  type DimOfUnit Candela = LuminousIntensity+instance Show Candela where+  show _ = "cd"++data Hertz = Hertz+instance Unit Hertz where+  type BaseUnit Hertz = Number :/ Second+instance Show Hertz where+  show _ = "Hz"++-- | This is not in the SI standard, but is used widely.+data Liter = Liter+instance Unit Liter where+  type BaseUnit Liter = (Centi :@ Meter) :^ Three+  conversionRatio _ = 1000+instance Show Liter where+  show _ = "l"++type Litre = Liter+pattern Litre = Liter++data Newton = Newton+instance Unit Newton where+  type BaseUnit Newton = Gram :* Meter :/ (Second :^ Two)+  conversionRatio _ = 1000+instance Show Newton where+  show _ = "N"++data Pascal = Pascal+instance Unit Pascal where+  type BaseUnit Pascal = Newton :/ (Meter :^ Two)+instance Show Pascal where+  show _ = "Pa"++data Joule = Joule+instance Unit Joule where+  type BaseUnit Joule = Newton :* Meter+instance Show Joule where+  show _ = "J"++data Watt = Watt+instance Unit Watt where+  type BaseUnit Watt = Joule :/ Second+instance Show Watt where+  show _ = "W"++data Coulomb = Coulomb+instance Unit Coulomb where+  type BaseUnit Coulomb = Ampere :* Second+instance Show Coulomb where+  show _ = "C"++data Volt = Volt+instance Unit Volt where+  type BaseUnit Volt = Watt :/ Ampere+instance Show Volt where+  show _ = "V"++data Farad = Farad+instance Unit Farad where+  type BaseUnit Farad = Coulomb :/ Volt+instance Show Farad where+  show _ = "F"++data Ohm = Ohm+instance Unit Ohm where+  type BaseUnit Ohm = Volt :/ Ampere+instance Show Ohm where+  show _ = "Ω"++data Siemens = Siemens+instance Unit Siemens where+  type BaseUnit Siemens = Ampere :/ Volt+instance Show Siemens where+  show _ = "S"++data Weber = Weber+instance Unit Weber where+  type BaseUnit Weber = Volt :* Second+instance Show Weber where+  show _ = "Wb"++data Tesla = Tesla+instance Unit Tesla where+  type BaseUnit Tesla = Weber :/ (Meter :^ Two)+instance Show Tesla where+  show _ = "T"++data Henry = Henry+instance Unit Henry where+  type BaseUnit Henry = Weber :/ Ampere+instance Show Henry where+  show _ = "H"++data Lumen = Lumen+instance Unit Lumen where+  type BaseUnit Lumen = Candela+instance Show Lumen where+  show _ = "lm"++data Lux = Lux+instance Unit Lux where+  type BaseUnit Lux = Lumen :/ (Meter :^ Two)+instance Show Lux where+  show _ = "lx"++data Becquerel = Becquerel+instance Unit Becquerel where+  type BaseUnit Becquerel = Number :/ Second+instance Show Becquerel where+  show _ = "Bq"++data Gray = Gray+instance Unit Gray where+  type BaseUnit Gray = (Meter :^ Two) :/ (Second :^ Two)+instance Show Gray where+  show _ = "Gy"++data Sievert = Sievert+instance Unit Sievert where+  type BaseUnit Sievert = (Meter :^ Two) :/ (Second :^ Two)+instance Show Sievert where+  show _ = "Sv"++data Katal = Katal+instance Unit Katal where+  type BaseUnit Katal = Mole :/ Second+instance Show Katal where+  show _ = "kat"++-- | Derived SI unit+data Hectare = Hectare+instance Unit Hectare where+  type BaseUnit Hectare = Meter :^ Two+  conversionRatio _ = 10000+instance Show Hectare where+  show _ = "ha"++-- | Derived SI unit+data Ton = Ton+instance Unit Ton where+  type BaseUnit Ton = Kilo :@ Gram+  conversionRatio _ = 1000+instance Show Ton where+  show _ = "t"++type Tonne = Ton+pattern Tonne = Ton++-- | A list of the names of all unit types. Useful with+-- 'Data.Metrology.Parser.makeQuasiQuoter'.+siUnits :: [Name]+siUnits =+  [ ''Meter, ''Gram, ''Second, ''Minute, ''Hour, ''Day, ''Ampere+  , ''Kelvin, ''Mole, ''Candela, ''Hertz, ''Liter, ''Newton, ''Pascal+  , ''Joule, ''Watt, ''Coulomb, ''Volt, ''Farad, ''Ohm, ''Siemens+  , ''Weber, ''Tesla, ''Henry, ''Lumen, ''Lux, ''Becquerel, ''Gray+  , ''Sievert, ''Katal, ''Hectare, ''Ton+  ]+
units.cabal view
@@ -1,5 +1,5 @@ name:           units-version:        2.0+version:        2.1 cabal-version:  >= 1.10 synopsis:       A domain-specific type system for dimensional analysis homepage:       http://www.cis.upenn.edu/~eir/packages/units@@ -8,7 +8,14 @@ maintainer:     Richard Eisenberg <eir@cis.upenn.edu>, Takayuki Muranushi <muranushi@gmail.com> bug-reports:    https://github.com/goldfirere/units/issues stability:      experimental-extra-source-files: README.md, CHANGES.md+extra-source-files: README.md+                  , CHANGES.md+                  , Tests/*.hs+                  , Tests/Compile/*.hs+                  , Tests/Compile/UnitParser/*.hs+                  , units-defs/Data/Metrology/*.hs+                  , units-defs/Data/Metrology/SI/*.hs+                  , units-defs/Data/Metrology/Imperial/*.hs license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -34,54 +41,70 @@ source-repository this   type:     git   location: https://github.com/goldfirere/units.git-  tag:      v2.0+  tag:      v2.1  library-  build-depends:      -      base >= 4.7 && < 5,-      singletons >= 0.9 && < 1+  ghc-options: -Wall+  build-depends: base >= 4.7 && < 5+               , th-desugar >= 1.4.2+               , singletons >= 0.9 && < 2+               , vector-space >= 0.8+               , template-haskell+               , mtl >= 1.1+               , multimap >= 1.2+               , syb >= 0.3+               , containers >= 0.4+               , parsec >= 3   exposed-modules:         Data.Metrology,      Data.Metrology.Internal,     Data.Metrology.Show,     Data.Metrology.Unsafe,     Data.Metrology.Z,-    Data.Metrology.Set+    Data.Metrology.Set,+    Data.Metrology.Vector,+    Data.Metrology.Parser,+    Data.Metrology.Poly,+    Data.Metrology.TH,+    Data.Metrology.Quantity    other-modules:          Data.Metrology.Factor,     Data.Metrology.LCSU,-    Data.Metrology.Quantity, +    Data.Metrology.Qu,     Data.Metrology.Dimensions,     Data.Metrology.Units,     Data.Metrology.Combinators,-    Data.Metrology.Validity+    Data.Metrology.Validity,+    Data.Metrology.Parser.Internal      -- cabal now recommends that TH be explicitly listed in cabal files   default-extensions: TemplateHaskell   default-language:   Haskell2010 ---- Here are some test scripts for `units`. Since `units` is a--- type-level library and mainly works at compile time, we're just--- testing if these programs compiles and runs properlly.--- --- !IMPORTANT! You need to type------ > make prepare-test------ once, to bring the specific unit definitions from `units-defs`--- into scope to run the tests.+test-suite main+  type:             exitcode-stdio-1.0+  main-is:          Tests/Main.hs+  default-language: Haskell2010+  build-depends:    units+                  , base >= 4.7 && < 5+                  , th-desugar >= 1.4.2+                  , singletons >= 0.9 && < 2+                  , vector-space >= 0.8+                  , tasty >= 0.8+                  , tasty-hunit >= 0.8+                  , HUnit-approx >= 1.0+                  , template-haskell+                  , mtl >= 1.1+                  , multimap >= 1.2+                  , syb >= 0.3+                  , containers >= 0.4+                  , parsec >= 3+  hs-source-dirs:   units-defs, . -Test-Suite travel-  Type:               exitcode-stdio-1.0-  Hs-Source-Dirs:     Test-  Ghc-Options:        -Wall-  Main-Is:            Travel.hs-  Other-Modules:        -                        -  Build-Depends:        -      base-    , units+    -- optimize compile time, not runtime!+  ghc-options:        -O0 -Wall -Werror -main-is Tests.Main -  default-language:   Haskell2010+    -- GHC 7.10 requires this in more places, and I don't feel like ferreting out exactly+    -- where.+  default-extensions: FlexibleContexts