units 2.1 → 2.2
raw patch · 16 files changed
+264/−104 lines, 16 files
Files
- CHANGES.md +11/−0
- Data/Metrology/Combinators.hs +12/−6
- Data/Metrology/Factor.hs +4/−3
- Data/Metrology/Parser.hs +55/−4
- Data/Metrology/Parser/Internal.hs +3/−47
- Data/Metrology/Poly.hs +3/−3
- Data/Metrology/Qu.hs +9/−6
- Data/Metrology/TH.hs +51/−21
- Data/Metrology/Vector.hs +5/−5
- Tests/Compile/EvalType.hs +5/−1
- Tests/Compile/TH.hs +2/−2
- Tests/Linearity.hs +30/−0
- Tests/Main.hs +4/−0
- Tests/README.md +19/−0
- Tests/Vector.hs +44/−0
- units.cabal +7/−6
CHANGES.md view
@@ -1,3 +1,14 @@+Version 2.2+-----------++* Some types of arithmetic operations are different to aid in type inference.+For example, `*|` does not normalize its dimension list.++* The types of the `derive...` TH functions now allow for deriving units+based on composite dimensions/units.++* New TH function to help declare constants, called `declareConstant`.+ Version 2.1 -----------
Data/Metrology/Combinators.hs view
@@ -28,7 +28,8 @@ data u1 :* u2 = u1 :* u2 instance (Dimension d1, Dimension d2) => Dimension (d1 :* d2) where- type DimFactorsOf (d1 :* d2) = (DimFactorsOf d1) @+ (DimFactorsOf d2)+ type DimFactorsOf (d1 :* d2)+ = Normalize ((DimFactorsOf d1) @+ (DimFactorsOf d2)) instance (Unit u1, Unit u2) => Unit (u1 :* u2) where @@ -37,7 +38,8 @@ type DimOfUnit (u1 :* u2) = DimOfUnit u1 :* DimOfUnit u2 conversionRatio _ = undefined -- this should never be called - type UnitFactorsOf (u1 :* u2) = (UnitFactorsOf u1) @+ (UnitFactorsOf u2)+ type UnitFactorsOf (u1 :* u2)+ = Normalize ((UnitFactorsOf u1) @+ (UnitFactorsOf u2)) canonicalConvRatio _ = canonicalConvRatio (undefined :: u1) * canonicalConvRatio (undefined :: u2) @@ -53,13 +55,15 @@ data u1 :/ u2 = u1 :/ u2 instance (Dimension d1, Dimension d2) => Dimension (d1 :/ d2) where- type DimFactorsOf (d1 :/ d2) = (DimFactorsOf d1) @- (DimFactorsOf d2)+ type DimFactorsOf (d1 :/ d2)+ = Normalize ((DimFactorsOf d1) @- (DimFactorsOf d2)) instance (Unit u1, Unit u2) => Unit (u1 :/ u2) where type BaseUnit (u1 :/ u2) = Canonical type DimOfUnit (u1 :/ u2) = DimOfUnit u1 :/ DimOfUnit u2 conversionRatio _ = undefined -- this should never be called- type UnitFactorsOf (u1 :/ u2) = (UnitFactorsOf u1) @- (UnitFactorsOf u2)+ type UnitFactorsOf (u1 :/ u2)+ = Normalize ((UnitFactorsOf u1) @- (UnitFactorsOf u2)) canonicalConvRatio _ = canonicalConvRatio (undefined :: u1) / canonicalConvRatio (undefined :: u2) @@ -75,14 +79,16 @@ data unit :^ (power :: Z) = unit :^ Sing power instance Dimension dim => Dimension (dim :^ power) where- type DimFactorsOf (dim :^ power) = (DimFactorsOf dim) @* power+ type DimFactorsOf (dim :^ power)+ = Normalize ((DimFactorsOf dim) @* power) instance (Unit unit, SingI power) => Unit (unit :^ power) where type BaseUnit (unit :^ power) = Canonical type DimOfUnit (unit :^ power) = DimOfUnit unit :^ power conversionRatio _ = undefined - type UnitFactorsOf (unit :^ power) = (UnitFactorsOf unit) @* power+ type UnitFactorsOf (unit :^ power)+ = Normalize ((UnitFactorsOf unit) @* power) canonicalConvRatio _ = canonicalConvRatio (undefined :: unit) ^^ (szToInt (sing :: Sing power)) type instance DefaultUnitOfDim (d :^ z) = DefaultUnitOfDim d :^ z
Data/Metrology/Factor.hs view
@@ -88,9 +88,10 @@ -- Reorder [] x ==> [] -- @ type family Reorder (a :: [Factor *]) (b :: [Factor *]) :: [Factor *] where- Reorder x x = x- Reorder '[] x = '[]- Reorder x '[] = x+ Reorder x x = x+ Reorder '[] x = '[]+ Reorder '[x] y = '[x]+ Reorder x '[] = x Reorder x (h ': t) = Reorder' (Extract h x) t -- | Helper function in 'Reorder'
Data/Metrology/Parser.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell, CPP #-}- ----------------------------------------------------------------------------- -- | -- Module : Data.Metrology.Parser@@ -44,6 +42,9 @@ -- @dam@ is ambiguous like this. ----------------------------------------------------------------------------- +{-# LANGUAGE TemplateHaskell, CPP #-}+{-# OPTIONS_HADDOCK prune #-}+ module Data.Metrology.Parser ( -- * Quasiquoting interface makeQuasiQuoter, allUnits, allPrefixes,@@ -55,12 +56,15 @@ -- necessary. parseUnit, UnitExp(..), SymbolTable,- mkSymbolTable+ mkSymbolTable,++ -- for internal use only+ parseUnitExp, parseUnitType ) where import Prelude hiding ( exp ) -import Language.Haskell.TH+import Language.Haskell.TH hiding ( Pred ) import Language.Haskell.TH.Quote import Language.Haskell.TH.Desugar.Lift () -- get the Lift Name instance import Data.Maybe@@ -70,6 +74,49 @@ import Data.Metrology import Data.Metrology.TH +----------------------------------------------------------------------+-- 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!++----------------------------------------------------------------------+-- QuasiQuoters+----------------------------------------------------------------------+ emptyQQ :: QuasiQuoter emptyQQ = QuasiQuoter { quoteExp = \_ -> fail "No quasi-quoter for expressions" , quotePat = \_ -> fail "No quasi-quoter for patterns"@@ -115,6 +162,10 @@ prefix_pairs <- mapM mk_pair prefix_names unit_pairs <- mapM mk_pair unit_names [| mkSymbolTable $( return $ ListE prefix_pairs ) $( return $ ListE unit_pairs ) |]++----------------------------------------------------------------------+-- Getting instances+---------------------------------------------------------------------- getInstanceNames :: Name -> Q [Name] getInstanceNames class_name = do
Data/Metrology/Parser/Internal.hs view
@@ -4,13 +4,12 @@ This file defines a parser for unit expressions. -} -{-# LANGUAGE LambdaCase, TemplateHaskell, NoMonomorphismRestriction,- FlexibleContexts, RankNTypes #-}+{-# LANGUAGE LambdaCase, NoMonomorphismRestriction,+ FlexibleContexts, RankNTypes, Safe #-} module Data.Metrology.Parser.Internal ( UnitExp(..), parseUnit, - parseUnitExp, parseUnitType, SymbolTable(..), mkSymbolTable, -- only for testing purposes:@@ -29,10 +28,6 @@ import Data.Maybe import Data.Char -import Data.Metrology--import Language.Haskell.TH hiding ( Pred )- ---------------------------------------------------------------------- -- Basic combinators ----------------------------------------------------------------------@@ -159,7 +154,7 @@ data SymbolTable pre u = SymbolTable { prefixTable :: PrefixTable pre , unitTable :: UnitTable u }- deriving Show+-- 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)@@ -352,43 +347,4 @@ 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
@@ -229,14 +229,14 @@ infixl 7 *| , |* , |/ -- | Multiply a quantity by a scalar from the left-(*|) :: Num n => n -> Qu b l n -> Qu (Normalize b) l n+(*|) :: 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 (Normalize a) l n+(|*) :: Num n => Qu a l n -> n -> Qu 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+(|/) :: Fractional n => Qu a l n -> n -> Qu a l n (Qu a) |/ b = Qu (a / b)
Data/Metrology/Qu.hs view
@@ -211,12 +211,15 @@ --- 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)+-- Express the condition on `d` via a constraint, so that the+-- requirement for the Num class can inform the choice of+-- dimension. See #35.+deriving instance (d ~ '[], Num n) => Num (Qu d l n)+deriving instance (d ~ '[], Real n) => Real (Qu d l n)+deriving instance (d ~ '[], Fractional n) => Fractional (Qu d l n)+deriving instance (d ~ '[], Floating n) => Floating (Qu d l n)+deriving instance (d ~ '[], RealFrac n) => RealFrac (Qu d l n)+deriving instance (d ~ '[], RealFloat n) => RealFloat (Qu d l n) ------------------------------------------------------------- --- Combinators ---------------------------------------------
Data/Metrology/TH.hs view
@@ -17,19 +17,21 @@ module Data.Metrology.TH ( evalType, declareDimension, declareCanonicalUnit, declareDerivedUnit, declareMonoUnit,-+ declareConstant,+ -- 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 ( dsType, sweeten )+import Language.Haskell.TH.Desugar.Expand ( expandType ) import Language.Haskell.TH.Desugar.Lift () -- need Lift Rational import Data.Metrology.Dimensions import Data.Metrology.Units import Data.Metrology.LCSU+import Data.Metrology.Poly -- | "Evaluates" a type as far as it can. This is useful, say, in instance -- declarations:@@ -87,52 +89,47 @@ -- | @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+-- named @unit_name@, measuring dimension @dim@. @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 "Meter" [t| Length |] (Just "m"))+declareCanonicalUnit :: String -> Q Type -> 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 |]+ type DimOfUnit $unit_type = $dim |] 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.+-- a new derived unit, expressed in terms of @base_unit_type@. @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 "Minute" [t| Second |] 60 (Just "min"))+declareDerivedUnit :: String -> Q Type -> 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+ type BaseUnit $unit_type = $base_unit 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@@ -173,3 +170,36 @@ where unit_name = mkName unit_name_str unit_type = return $ ConT unit_name++-- | @declareConstant const_name value unit_type@ creates a new numerical+-- constant, named @const_name@. Its numerical value is @value@ expressed+-- in units given by @unit_type@. The constant is polymorphic in both its+-- LCSU and numerical representation. For example,+--+-- > declareConstant "gravity_g" 9.80665 [t| Meter :/ Second :^ Two |]+--+-- yields+--+-- > gravity_g :: ( Fractional n+-- > , CompatibleUnit lcsu (Meter :/ Second :^ Two) )+-- > => MkQu_ULN (Meter :/ Second :^ Two) lcsu n+-- > gravity_g = 9.80665 % (undefined :: Meter :/ Second :^ Two)+declareConstant :: String -> Rational -> Q Type -> Q [Dec]+declareConstant name value q_unit_type = do+ unit_type <- q_unit_type+ lcsu_name <- newName "lcsu"+ n_name <- newName "n"+ let lcsu = VarT lcsu_name+ n = VarT n_name+ const_name = mkName name+ const_type = ForallT [PlainTV lcsu_name, PlainTV n_name]+ [ ClassP ''Fractional [n]+ , ClassP ''CompatibleUnit [lcsu, unit_type] ] $+ ConT ''MkQu_ULN `AppT` unit_type `AppT` lcsu `AppT` n+ ty_sig = SigD const_name const_type+ dec = ValD (VarP const_name) (NormalB $+ VarE '(%) `AppE` LitE (RationalL value)+ `AppE` SigE (VarE 'undefined)+ unit_type) []+ return [ty_sig, dec]+
Data/Metrology/Vector.hs view
@@ -163,19 +163,19 @@ infixl 7 |/ -- | Divide a quantity by a scalar-(|/) :: (VectorSpace n, Fractional (Scalar n)) => Qu a l n -> Scalar n -> Qu (Normalize a) l n+(|/) :: (VectorSpace n, Fractional (Scalar n)) => Qu a l n -> Scalar n -> Qu 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+(*|) :: VectorSpace n => Scalar n -> Qu b l n -> Qu b l n+a *| (Qu b) = Qu (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+(|*) :: VectorSpace n => Qu a l n -> Scalar n -> Qu a l n+(Qu a) |* b = Qu (a ^* b) --------------------------------------- -- Multiplicative operations
Tests/Compile/EvalType.hs view
@@ -2,7 +2,7 @@ Copyright (c) 2014 Richard Eisenberg -} -{-# LANGUAGE TemplateHaskell, FlexibleInstances, DataKinds #-}+{-# LANGUAGE TemplateHaskell, FlexibleInstances, DataKinds, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Tests.Compile.EvalType where@@ -14,3 +14,7 @@ instance Show $(evalType [t| Length |]) where show x = x `showIn` Meter +#if MIN_VERSION_th_desugar(1,5,0)+instance Show $(evalType [t| Volume |]) where+ show x = x `showIn` Liter+#endif
Tests/Compile/TH.hs view
@@ -7,8 +7,8 @@ import qualified Data.Metrology as Mono $(declareDimension "Length")-$(declareCanonicalUnit "Meter" ''Length (Just "m"))-$(declareDerivedUnit "Foot" ''Meter 0.3048 Nothing)+$(declareCanonicalUnit "Meter" [t| Length |] (Just "m"))+$(declareDerivedUnit "Foot" [t| Meter |] 0.3048 Nothing) type MyLCSU = MkLCSU '[(Length, Meter)]
+ Tests/Linearity.hs view
@@ -0,0 +1,30 @@+{- Test the property of quantity as linear space+ Copyright (c) 2014 Richard Eisenberg+-}++module Tests.Linearity where++import Data.Metrology.Poly+import Data.Metrology.Show ()+import Data.Metrology.SI.Poly++import Test.Tasty+import Test.Tasty.HUnit++len1 :: Length SI Rational+len1 = 1 % Meter++linearCompose :: (Fractional a) => a -> a -> Qu d l a -> Qu d l a -> Qu d l a +linearCompose a b x y = a *| x |+| b *| y+++tests :: TestTree+tests = testGroup "Show"+ [ testCase "Identity" $ len1 @?= len1+ , testCase "Addition" $ len1 |+| len1 @?= 2 *| len1 + , testCase "Summation of multiple quantities" $ + qSum [len1,len1,len1] @?= 3 *| len1 + , testCase "Linear composition" $ + linearCompose 0.2 0.8 len1 len1 @?= len1+ ]+
Tests/Main.hs view
@@ -28,12 +28,14 @@ import qualified Tests.Imperial import qualified Tests.LennardJones+import qualified Tests.Linearity 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 qualified Tests.Vector import Test.Tasty @@ -46,10 +48,12 @@ testGroup "Tests" [ Tests.Imperial.tests , Tests.LennardJones.tests+ , Tests.Linearity.tests , Tests.OffSystemAdd.tests , Tests.OffSystemCSU.tests , Tests.Parser.tests , Tests.PhysicalConstants.tests , Tests.Show.tests , Tests.Travel.tests+ , Tests.Vector.tests ]
+ Tests/README.md view
@@ -0,0 +1,19 @@+`units` Test Design+===================++There are two kinds of test:++ - `Compile` tests test only compilation, not any functionality. A new `Compile`+ test should be placed in the `Compile` directory and imported from+ `Tests.Main`, in alphabetical order with the others.++ - Other tests test both compilation and some functionality. These use the+ [`tasty`](http://hackage.haskell.org/package/tasty) testing framework,+ avaiable on Hackage. Each of these tests should export a + `tests :: TestTree` definition which contain all the tests in+ the module. Then, this `tests` should be imported and run from within+ `Tests.Main`, following the style there.++To run the tests, just say `cabal test`. You will need to say `git submodule+update --init` to download the contents of `units-defs`, necessary for testing+purposes.
+ Tests/Vector.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TypeFamilies #-}++{- Test the property of vector quantity + Copyright (c) 2014 Richard Eisenberg+-}++module Tests.Vector where++import Data.Metrology.Vector+import Data.Metrology.Show ()+import Data.Metrology.SI.Poly+import Data.VectorSpace++import Test.Tasty+import Test.Tasty.HUnit++len1 :: Length SI Rational+len1 = 1 % Meter+++type V2 = Length SI (Rational, Rational) +vec1 :: V2+vec1 = (2,3) % Meter++linearCompose :: (VectorSpace n, a ~ Scalar n) => a -> a -> Qu d l n -> Qu d l n -> Qu d l n+linearCompose a b x y = a *| x |+| b *| y+++tests :: TestTree+tests = testGroup "Show"+ [ testCase "Identity" $ vec1 @?= vec1+ , testCase "Addition" $ vec1 |+| vec1 @?= 2 *| vec1 + , testCase "Summation of multiple quantities" $ + qSum [vec1,vec1,vec1] @?= 3 *| vec1 + , testCase "Linear composition" $ + linearCompose 0.2 0.8 vec1 vec1 @?= vec1++ , testCase "Multiplication from right" $ 4 *| vec1 @?= vec1 |* 4+ , testCase "Division by scalar" $ 10 *| vec1 @?= vec1 |/ 0.1++ , testCase "scalar product" $+ (5 % Meter) |*^| vec1 @?= ((10, 15) % (Meter :^ sTwo))+ ]+
units.cabal view
@@ -1,8 +1,8 @@ name: units-version: 2.1+version: 2.2 cabal-version: >= 1.10 synopsis: A domain-specific type system for dimensional analysis-homepage: http://www.cis.upenn.edu/~eir/packages/units+homepage: https://github.com/goldfirere/units category: Math author: Richard Eisenberg <eir@cis.upenn.edu> maintainer: Richard Eisenberg <eir@cis.upenn.edu>, Takayuki Muranushi <muranushi@gmail.com>@@ -11,6 +11,7 @@ extra-source-files: README.md , CHANGES.md , Tests/*.hs+ , Tests/README.md , Tests/Compile/*.hs , Tests/Compile/UnitParser/*.hs , units-defs/Data/Metrology/*.hs@@ -41,7 +42,7 @@ source-repository this type: git location: https://github.com/goldfirere/units.git- tag: v2.1+ tag: v2.2 library ghc-options: -Wall@@ -79,8 +80,8 @@ Data.Metrology.Parser.Internal -- cabal now recommends that TH be explicitly listed in cabal files- default-extensions: TemplateHaskell- default-language: Haskell2010+ other-extensions: TemplateHaskell+ default-language: Haskell2010 test-suite main type: exitcode-stdio-1.0@@ -103,7 +104,7 @@ hs-source-dirs: units-defs, . -- optimize compile time, not runtime!- ghc-options: -O0 -Wall -Werror -main-is Tests.Main+ ghc-options: -O0 -Wall -main-is Tests.Main -- GHC 7.10 requires this in more places, and I don't feel like ferreting out exactly -- where.