diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,16 @@ Release notes for `units` ========================= +Version 2.4 +----------- +* New interface with the `linear` package in `Data.Metrology.Linear`. + +* New `Show` and `Read` instances for dimensionless quantities. + +* New `NFData` instances for quantities, thanks to @rimmington. + +* GHC 8 compatibility. + Version 2.3 ----------- * `Data.Metrology.TH.evalType` now works in GHC 7.10 on dimensions like `Volume` instead diff --git a/Data/Metrology/Combinators.hs b/Data/Metrology/Combinators.hs --- a/Data/Metrology/Combinators.hs +++ b/Data/Metrology/Combinators.hs @@ -7,9 +7,13 @@ This file defines combinators to build more complex units and dimensions from simpler ones. -} -{-# LANGUAGE TypeOperators, TypeFamilies, UndecidableInstances, +{-# LANGUAGE TypeOperators, TypeFamilies, UndecidableInstances, ScopedTypeVariables, DataKinds, FlexibleInstances, - ConstraintKinds #-} + ConstraintKinds, CPP #-} + +#if __GLASGOW_HASKELL__ >= 711 +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +#endif module Data.Metrology.Combinators where diff --git a/Data/Metrology/Linear.hs b/Data/Metrology/Linear.hs new file mode 100644 --- /dev/null +++ b/Data/Metrology/Linear.hs @@ -0,0 +1,319 @@ +{-# LANGUAGE TypeOperators, FlexibleContexts, DataKinds, TypeFamilies, + ScopedTypeVariables, ConstraintKinds, GeneralizedNewtypeDeriving, + MultiParamTypeClasses, FlexibleInstances, InstanceSigs, CPP #-} + +#if __GLASGOW_HASKELL__ >= 711 +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +#endif + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Metrology.Linear +-- Copyright : (C) 2014 Richard Eisenberg, (C) 2015 Tobias Markus +-- 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 +-- @linear@ library. +------------------------------------------------------------------------------ + +module Data.Metrology.Linear ( + -- * 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 + zeroV, (|^+^|), (|^-^|), qNegateV, qSumV, + + -- ** Multiplicative operations + (|*^|), (|^*|), (|^/|), (*^|), (|^*), (|^/), (|.|), + + -- ** Vector-space operations + qBasis, qBasisFor, qScaled, qOuter, qUnit, + qQuadrance, qNorm, qSignorm, qProject, qCross, + + -- ** Affine operations + (|.-.|), (|.+^|), (|.-^|), qQd, qDistance, qQdA, qDistanceA, + + -- * Nondimensional units, conversion between quantities and numeric values + numInV, (^#), quOfV, (^%), showInV, + convertV, constantV, + + ) 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 Linear +import Linear.Affine hiding (P) +import qualified Control.Lens as Lens + +import Data.Proxy +import Data.Foldable as F +#if __GLASGOW_HASKELL__ < 709 +import Data.Traversable ( Traversable ) +#endif + +--------------------------------------- +-- Additive operations +--------------------------------------- + +-- | The number 0, polymorphic in its dimension. Use of this will +-- often require a type annotation. +zeroV :: (Additive f, Num a) => Qu d l (f a) +zeroV = Qu Linear.zero + +infixl 6 |^+^| +-- | Add two compatible vector quantities +(|^+^|) :: (d1 @~ d2, Additive f, Num a) + => Qu d1 l (f a) -> Qu d2 l (f a) -> Qu d1 l (f a) +(Qu a) |^+^| (Qu b) = Qu (a ^+^ b) + +-- | Negate a vector quantity +qNegateV :: (Additive f, Num a) => Qu d l (f a) -> Qu d l (f a) +qNegateV (Qu x) = Qu (negated x) + +infixl 6 |^-^| +-- | Subtract two compatible quantities +(|^-^|) :: (d1 @~ d2, Additive f, Num a) + => Qu d1 l (f a) -> Qu d2 l (f a) -> Qu d1 l (f a) +(Qu a) |^-^| (Qu b) = Qu (a ^-^ b) + +-- | Take the sum of a list of quantities +qSumV :: (Foldable t, Additive f, Num a) => t (Qu d l (f a)) -> Qu d l (f a) +qSumV = F.foldr (|^+^|) zeroV + +--------------------------------------- +-- Multiplicative operations +--------------------------------------- + +infixl 7 |*^|, |^*|, |^/| +-- | Multiply a scalar quantity by a vector quantity +(|*^|) :: (Functor f, Num a) + => Qu d1 l a -> Qu d2 l (f a) -> Qu (Normalize (d1 @+ d2)) l (f a) +(Qu a) |*^| (Qu b) = Qu (a *^ b) + +-- | Multiply a vector quantity by a scalar quantity +(|^*|) :: (Functor f, Num a) + => Qu d1 l (f a) -> Qu d2 l a -> Qu (Normalize (d1 @+ d2)) l (f a) +(Qu a) |^*| (Qu b) = Qu (a ^* b) + +-- | Divide a vector quantity by a scalar quantity +(|^/|) :: (Functor f, Fractional a) + => Qu d1 l (f a) -> Qu d2 l a -> Qu (Normalize (d1 @- d2)) l (f a) +(Qu a) |^/| (Qu b) = Qu (a ^/ b) + +infixl 7 |^/ +-- | Divide a quantity by a plain old number +(|^/) :: (Functor f, Fractional a) => Qu d l (f a) -> a -> Qu d l (f a) +(Qu a) |^/ b = Qu (a ^/ b) + +infixl 7 *^| , |^* +-- | Multiply a quantity by a plain old number from the left +(*^|) :: (Functor f, Num a) => a -> Qu b l (f a) -> Qu b l (f a) +a *^| (Qu b) = Qu (a *^ b) + +-- | Multiply a quantity by a plain old number from the right +(|^*) :: (Functor f, Num a) => Qu b l (f a) -> a -> Qu b l (f a) +(Qu a) |^* b = Qu (a ^* b) + +--------------------------------------- +-- Vector-space operations +--------------------------------------- + +-- | Return a default basis, where each basis element measures 1 of the +-- unit provided. +qBasis :: ( ValidDLU dim lcsu unit + , Additive f + , Traversable f + , Fractional a ) + => unit -> [Qu dim lcsu (f a)] +qBasis u = map (^% u) basis + +-- | Return a default basis for the vector space provided. Each basis +-- element measures 1 of the unit provided. +qBasisFor :: ( ValidDLU dim lcsu unit + , Additive f + , Traversable f + , Fractional a ) + => unit -> Qu dim lcsu (f b) -> [Qu dim lcsu (f a)] +qBasisFor u (Qu vec) = map (^% u) (basisFor vec) + +-- | Produce a diagonal (scale) matrix from a vector +qScaled :: (Traversable f, Num a) + => Qu dim lcsu (f a) -> Qu dim lcsu (f (f a)) +qScaled (Qu vec) = Qu (scaled vec) + +-- | Outer (tensor) product of two quantity vectors +qOuter :: (Functor f, Functor g, Num a) + => Qu d1 l (f a) -> Qu d2 l (g a) -> Qu (Normalize (d1 @+ d2)) l (f (g a)) +qOuter (Qu a) (Qu b) = Qu (a `outer` b) + +-- | Create a unit vector from a setter and a choice of unit. +qUnit :: (ValidDLU dim lcsu unit, Additive t, Fractional a) + => Lens.ASetter' (t a) a -> unit -> Qu dim lcsu (t a) +qUnit setter u = unit setter ^% u + +infixl 7 |.| +-- | Take a inner (dot) product between two quantities. +(|.|) :: (Metric f, Num a) => Qu d1 l (f a) -> Qu d2 l (f a) -> Qu (Normalize (d1 @+ d2)) l a +(Qu a) |.| (Qu b) = Qu (a `dot` b) + +-- | Square the length of a vector. +qQuadrance :: (Metric f, Num a) => Qu d l (f a) -> Qu (d @* Z.Two) l a +qQuadrance (Qu x) = Qu (quadrance x) + +-- | Length of a vector. +qNorm :: (Metric f, Floating a) => Qu d l (f a) -> Qu d l a +qNorm (Qu x) = Qu (norm 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. +qSignorm :: (Metric f, Floating a) + => Qu d l (f a) -> Qu '[] l (f a) +qSignorm (Qu x) = Qu (signorm x) + +-- | @qProject u v@ computes the projection of @v@ onto @u@. +qProject :: (Metric f, Fractional a) + => Qu d2 l (f a) -> Qu d1 l (f a) -> Qu d1 l (f a) +qProject (Qu u) (Qu v) = Qu (u `project` v) + +-- | Cross product of 3D vectors. +qCross :: Num a + => Qu d1 l (V3 a) -> Qu d2 l (V3 a) -> Qu (Normalize (d1 @+ d2)) l (V3 a) +qCross (Qu x) (Qu y) = Qu (x `cross` y) + +-- | Square of the distance between two vectors. +qQd :: (d1 @~ d2, Metric f, Metric (Diff f), Num a) + => Qu d1 l (f a) -> Qu d2 l (f a) -> Qu (d1 @* Z.Two) l a +qQd (Qu a) (Qu b) = Qu (a `qd` b) + +-- | Distance between two vectors. +qDistance :: (d1 @~ d2, Metric f, Metric (Diff f), Floating a) + => Qu d1 l (f a) -> Qu d2 l (f a) -> Qu d1 l a +qDistance (Qu a) (Qu b) = Qu (a `distance` b) + +--------------------------------------- +-- Affine space operations +--------------------------------------- + +-- | Subtract point quantities. +(|.-.|) :: (d1 @~ d2, Affine f, Num a) => Qu d1 l (f a) -> Qu d2 l (f a) -> Qu d1 l (Diff f a) +(Qu a) |.-.| (Qu b) = Qu (a .-. b) + +-- | Add a point to a vector. +(|.+^|) :: (d1 @~ d2, Affine f, Num a) => Qu d1 l (f a) -> Qu d2 l (Diff f a) -> Qu d1 l (f a) +(Qu a) |.+^| (Qu b) = Qu (a .+^ b) + +-- | Subract a vector from a point. +(|.-^|) :: (d1 @~ d2, Affine f, Num a) => Qu d1 l (f a) -> Qu d2 l (Diff f a) -> Qu d1 l (f a) +(Qu a) |.-^| (Qu b) = Qu (a .-^ b) + +-- | Square of the distance between two points. +qQdA :: (d1 @~ d2, Affine f, Foldable (Diff f), Num a) + => Qu d1 l (f a) -> Qu d2 l (f a) -> Qu (d1 @* Z.Two) l a +qQdA (Qu a) (Qu b) = Qu (a `qdA` b) + +-- | Distance between two points. +qDistanceA :: (d1 @~ d2, Affine f, Foldable (Diff f), Floating a) + => Qu d1 l (f a) -> Qu d2 l (f a) -> Qu d1 l a +qDistanceA (Qu a) (Qu b) = Qu (a `distanceA` 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 +numInV :: forall unit dim lcsu f a. + ( ValidDLU dim lcsu unit + , Functor f + , Fractional a ) + => Qu dim lcsu (f a) -> unit -> (f a) +numInV (Qu val) u + = val ^* fromRational + (canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu)) + / canonicalConvRatio u) + +infix 5 ^# +-- | Infix synonym for 'numIn' +(^#) :: ( ValidDLU dim lcsu unit + , Functor f + , Fractional a ) + => Qu dim lcsu (f a) -> unit -> (f a) +(^#) = numInV + +-- | Creates a dimensioned quantity in the given unit. For example: +-- +-- > height :: Length +-- > height = quOf 2.0 Meter +-- +-- or +-- +-- > height = 2.0 % Meter +quOfV :: forall unit dim lcsu f a. + ( ValidDLU dim lcsu unit + , Functor f + , Fractional a ) + => (f a) -> unit -> Qu dim lcsu (f a) +quOfV d u + = Qu (d ^* fromRational + (canonicalConvRatio u + / canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu)))) + +infixr 9 ^% +-- | Infix synonym for 'quOf' +(^%) :: ( ValidDLU dim lcsu unit + , Functor f + , Fractional a ) + => (f a) -> unit -> Qu dim lcsu (f a) +(^%) = quOfV + +-- | Dimension-keeping cast between different CSUs. +convertV :: forall d l1 l2 f a. + ( ConvertibleLCSUs d l1 l2 + , Functor f + , Fractional a ) + => Qu d l1 (f a) -> Qu d l2 (f a) +convertV (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. +constantV :: ( d @~ e + , ConvertibleLCSUs e DefaultLCSU l + , Functor f + , Fractional a ) + => Qu d DefaultLCSU (f a) -> Qu e l (f a) +constantV = convertV . redim + +infix 1 `showInV` +-- | Show a dimensioned quantity in a given unit. (The default @Show@ +-- instance always uses units as specified in the LCSU.) +showInV :: ( ValidDLU dim lcsu unit + , Functor f + , Fractional a + , Show unit + , Show a + , Show (f a) ) + => Qu dim lcsu (f a) -> unit -> String +showInV x u = show (x ^# u) ++ " " ++ show u diff --git a/Data/Metrology/Parser.hs b/Data/Metrology/Parser.hs --- a/Data/Metrology/Parser.hs +++ b/Data/Metrology/Parser.hs @@ -50,7 +50,7 @@ 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. @@ -153,7 +153,7 @@ , 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) |] @@ -172,7 +172,11 @@ ClassI _ insts <- reify class_name m_names <- forM insts $ \inst -> case inst of - InstanceD _ ((ConT class_name') `AppT` (ConT unit_name)) [] + InstanceD +#if __GLASGOW_HASKELL__ >= 711 + _ +#endif + _ ((ConT class_name') `AppT` (ConT unit_name)) [] | class_name == class_name' -> do show_insts <- reifyInstances ''Show [ConT unit_name] case show_insts of diff --git a/Data/Metrology/Poly.hs b/Data/Metrology/Poly.hs --- a/Data/Metrology/Poly.hs +++ b/Data/Metrology/Poly.hs @@ -10,8 +10,12 @@ {-# LANGUAGE ExplicitNamespaces, DataKinds, FlexibleInstances, TypeFamilies, TypeOperators, ConstraintKinds, ScopedTypeVariables, - FlexibleContexts, UndecidableInstances #-} + FlexibleContexts, UndecidableInstances, CPP #-} +#if __GLASGOW_HASKELL__ >= 711 +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.Metrology.Poly @@ -33,7 +37,7 @@ -- * Term-level combinators -- | The term-level arithmetic operators are defined by - -- applying vertical bar(s) to the sides the dimensioned + -- applying vertical bar(s) to the sides the dimensioned -- quantities acts on. -- ** Additive operations @@ -51,12 +55,12 @@ -- ** Comparison qCompare, (|<|), (|>|), (|<=|), (|>=|), (|==|), (|/=|), - qApprox, qNapprox, + qApprox, qNapprox, -- * Nondimensional units, conversion between quantities and numeric values numIn, (#), quOf, (%), showIn, unity, redim, convert, - defaultLCSU, constant, + defaultLCSU, constant, -- * Type-level unit combinators (:*)(..), (:/)(..), (:^)(..), (:@)(..), @@ -66,13 +70,13 @@ type (%*), type (%/), type (%^), -- * Creating quantity types - Qu, MkQu_D, MkQu_DLN, MkQu_U, MkQu_ULN, + Qu, MkQu_D, MkQu_DLN, MkQu_U, MkQu_ULN, -- * Creating new dimensions Dimension, -- * Creating new units - Unit(type BaseUnit, type DimOfUnit, conversionRatio), + Unit(type BaseUnit, type DimOfUnit, conversionRatio), Canonical, -- * Numbers, the only built-in unit @@ -130,10 +134,10 @@ -- -- or -- --- > inMeters x = x # Meter +-- > inMeters x = x # Meter numIn :: forall unit dim lcsu n. ( ValidDLU dim lcsu unit - , Fractional n ) + , Fractional n ) => Qu dim lcsu n -> unit -> n numIn (Qu val) u = val * fromRational @@ -182,7 +186,7 @@ showIn x u = show (x # u) ++ " " ++ show u -- | Dimension-keeping cast between different CSUs. -convert :: forall d l1 l2 n. +convert :: forall d l1 l2 n. ( ConvertibleLCSUs d l1 l2 , Fractional n ) => Qu d l1 n -> Qu d l2 n @@ -239,4 +243,3 @@ -- | Divide a quantity by a scalar (|/) :: Fractional n => Qu a l n -> n -> Qu a l n (Qu a) |/ b = Qu (a / b) - diff --git a/Data/Metrology/Qu.hs b/Data/Metrology/Qu.hs --- a/Data/Metrology/Qu.hs +++ b/Data/Metrology/Qu.hs @@ -12,8 +12,13 @@ {-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, UndecidableInstances, ConstraintKinds, StandaloneDeriving, GeneralizedNewtypeDeriving, - FlexibleInstances, RoleAnnotations, FlexibleContexts #-} + FlexibleInstances, RoleAnnotations, FlexibleContexts, + ScopedTypeVariables, CPP #-} +#if __GLASGOW_HASKELL__ >= 711 +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +#endif + module Data.Metrology.Qu where import Data.Metrology.Dimensions @@ -22,8 +27,12 @@ import Data.Metrology.Z import Data.Metrology.LCSU +import Control.DeepSeq (NFData (..)) import Data.VectorSpace +import Text.Read +import Data.Coerce + ------------------------------------------------------------- --- Internal ------------------------------------------------ ------------------------------------------------------------- @@ -163,14 +172,14 @@ => Qu d0 l n -- ^ /epsilon/ -> Qu d1 l n -- ^ left hand side -> Qu d2 l n -- ^ right hand side - -> Bool + -> Bool qApprox (Qu epsilon) (Qu a) (Qu b) = abs(a-b) <= epsilon --- | Compare two compatible quantities for approixmate inequality. +-- | 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 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 @@ -208,6 +217,7 @@ deriving instance Eq n => Eq (Qu d l n) deriving instance Ord n => Ord (Qu d l n) +deriving instance NFData n => NFData (Qu d l n) deriving instance AdditiveGroup n => AdditiveGroup (Qu d l n) instance VectorSpace n => VectorSpace (Qu d l n) where @@ -227,6 +237,22 @@ 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) + +-- But don't do this for Read and Show, because other instances +-- are indeed sensible. Using the above technique here would make +-- other instances impossible. Also, note that GeneralizedNewtypeDeriving +-- puts the "Qu" constructor in Read and Show instances, so don't use +-- that. +instance Show n => Show (Qu '[] l n) where + showsPrec = coerce (showsPrec :: Int -> n -> ShowS) + show = coerce (show :: n -> String) + showList = coerce (showList :: [n] -> ShowS) + +instance Read n => Read (Qu '[] l n) where + readsPrec = coerce (readsPrec :: Int -> ReadS n) + readList = coerce (readList :: ReadS [n]) + readPrec = coerce (readPrec :: ReadPrec n) + readListPrec = coerce (readListPrec :: ReadPrec [n]) ------------------------------------------------------------- --- Combinators --------------------------------------------- diff --git a/Data/Metrology/Show.hs b/Data/Metrology/Show.hs --- a/Data/Metrology/Show.hs +++ b/Data/Metrology/Show.hs @@ -1,5 +1,10 @@ {-# LANGUAGE PolyKinds, DataKinds, TypeOperators, FlexibleInstances, - ScopedTypeVariables, FlexibleContexts, ConstraintKinds #-} + ScopedTypeVariables, FlexibleContexts, ConstraintKinds, CPP #-} + +#if __GLASGOW_HASKELL__ < 709 +{-# LANGUAGE OverlappingInstances #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- @@ -71,8 +76,11 @@ build_string_helper [s] = s build_string_helper (h:t) = h ++ " * " ++ build_string_helper t -instance (ShowUnitFactor (LookupList dims lcsu), Show n) - => Show (Qu dims lcsu n) where +instance +#if __GLASGOW_HASKELL__ >= 709 + {-# OVERLAPPABLE #-} +#endif + (ShowUnitFactor (LookupList dims lcsu), Show n) + => Show (Qu dims lcsu n) where show (Qu d) = show d ++ (showFactor (Proxy :: Proxy (LookupList dims lcsu))) - diff --git a/Data/Metrology/TH.hs b/Data/Metrology/TH.hs --- a/Data/Metrology/TH.hs +++ b/Data/Metrology/TH.hs @@ -78,8 +78,13 @@ -- > instance Dimension Length declareDimension :: String -> Q [Dec] declareDimension str = - return [ DataD [] name [] [NormalC name []] [] - , InstanceD [] (ConT ''Dimension `AppT` ConT name) [] ] + return [ mkDataD [] name [] [NormalC name []] [] +#if __GLASGOW_HASKELL__ >= 711 + , InstanceD Nothing [] (ConT ''Dimension `AppT` ConT name) [] +#else + , InstanceD [] (ConT ''Dimension `AppT` ConT name) [] +#endif + ] where name = mkName str @@ -104,7 +109,7 @@ unit_instance <- [d| instance Unit $unit_type where type BaseUnit $unit_type = Canonical type DimOfUnit $unit_type = $dim |] - return $ (DataD [] unit_name [] [NormalC unit_name []] []) + return $ (mkDataD [] unit_name [] [NormalC unit_name []] []) : unit_instance ++ show_instance where unit_name = mkName unit_name_str @@ -127,7 +132,7 @@ unit_instance <- [d| instance Unit $unit_type where type BaseUnit $unit_type = $base_unit conversionRatio _ = ratio |] - return $ (DataD [] unit_name [] [NormalC unit_name []] []) + return $ (mkDataD [] unit_name [] [NormalC unit_name []] []) : unit_instance ++ show_instance where unit_name = mkName unit_name_str @@ -167,7 +172,7 @@ 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 []] []) + return $ (mkDataD [] unit_name [] [NormalC unit_name []] []) : show_instance ++ dim_instance ++ unit_instance ++ default_instance where unit_name = mkName unit_name_str @@ -209,4 +214,12 @@ mkClassP = ClassP #else mkClassP n tys = foldl AppT (ConT n) tys +#endif + +-- Local function that provides compatibility across TH versions +mkDataD :: Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Dec +#if __GLASGOW_HASKELL__ >= 711 +mkDataD ct name tvbs cons derivs = DataD ct name tvbs Nothing cons (map ConT derivs) +#else +mkDataD = DataD #endif diff --git a/Data/Metrology/Units.hs b/Data/Metrology/Units.hs --- a/Data/Metrology/Units.hs +++ b/Data/Metrology/Units.hs @@ -9,8 +9,12 @@ -} {-# LANGUAGE TypeFamilies, DataKinds, DefaultSignatures, MultiParamTypeClasses, - ConstraintKinds, UndecidableInstances, FlexibleContexts, + ConstraintKinds, UndecidableInstances, FlexibleContexts, CPP, FlexibleInstances, ScopedTypeVariables, TypeOperators, PolyKinds #-} + +#if __GLASGOW_HASKELL__ >= 711 +{-# LANGUAGE UndecidableSuperClasses #-} +#endif module Data.Metrology.Units where diff --git a/Data/Metrology/Validity.hs b/Data/Metrology/Validity.hs --- a/Data/Metrology/Validity.hs +++ b/Data/Metrology/Validity.hs @@ -33,11 +33,15 @@ 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) +type family Units (dfactors :: [Factor *]) :: Constraint where + Units '[] = () + Units (F unit z ': dfactors) = (Unit unit, Units dfactors) + ------------------------------------------------ -- Main validity functions ------------------------------------------------ @@ -47,6 +51,7 @@ ValidDLU dfactors lcsu unit = ( dfactors ~ DimFactorsOf (DimOfUnit unit) , UnitFactor (LookupList dfactors lcsu) + , Units (LookupList dfactors lcsu) -- needed only in GHC 8 , Unit unit , UnitFactorsOf unit *~ LookupList dfactors lcsu ) @@ -81,7 +86,7 @@ type family CanonicalUnitsOfFactors (fs :: [Factor *]) :: [*] where CanonicalUnitsOfFactors '[] = '[] CanonicalUnitsOfFactors (F u z ': fs) = (CanonicalUnit u) ': CanonicalUnitsOfFactors fs - + -- | Check if an LCSU has consistent entries for the given unit. i.e. can the lcsu -- describe the unit? type family CompatibleUnit (lcsu :: LCSU *) (unit :: *) :: Constraint where diff --git a/Data/Metrology/Vector.hs b/Data/Metrology/Vector.hs --- a/Data/Metrology/Vector.hs +++ b/Data/Metrology/Vector.hs @@ -1,6 +1,10 @@ -{-# LANGUAGE TypeOperators, FlexibleContexts, DataKinds, TypeFamilies, +{-# LANGUAGE TypeOperators, FlexibleContexts, DataKinds, TypeFamilies, CPP, ScopedTypeVariables, ConstraintKinds, GeneralizedNewtypeDeriving #-} +#if __GLASGOW_HASKELL__ >= 711 +{-# OPTIONS_GHC -Wno-redundant-constraints #-} +#endif + ----------------------------------------------------------------------------- -- | -- Module : Data.Metrology.Vector @@ -18,7 +22,7 @@ -- * Term-level combinators -- | The term-level arithmetic operators are defined by - -- applying vertical bar(s) to the sides the dimensioned + -- applying vertical bar(s) to the sides the dimensioned -- quantities acts on. -- ** Additive operations @@ -32,7 +36,7 @@ -- ** Multiplicative operations on vectors (|*^|), (|^*|), (|^/|), (|.|), - + -- ** Exponentiation (|^), (|^^), qNthRoot, qSq, qCube, qSqrt, qCubeRoot, @@ -43,15 +47,15 @@ -- ** Affine operations Point(..), QPoint, (|.-.|), (|.+^|), (|.-^|), qDistanceSq, qDistance, pointNumIn, (.#), quOfPoint, (%.), - + -- ** Comparison qCompare, (|<|), (|>|), (|<=|), (|>=|), (|==|), (|/=|), - qApprox, qNapprox, + qApprox, qNapprox, -- * Nondimensional units, conversion between quantities and numeric values numIn, (#), quOf, (%), showIn, unity, redim, convert, - defaultLCSU, constant, + defaultLCSU, constant, -- * Type-level unit combinators (:*)(..), (:/)(..), (:^)(..), (:@)(..), @@ -61,13 +65,13 @@ type (%*), type (%/), type (%^), -- * Creating quantity types - Qu, MkQu_D, MkQu_DLN, MkQu_U, MkQu_ULN, + Qu, MkQu_D, MkQu_DLN, MkQu_U, MkQu_ULN, -- * Creating new dimensions Dimension, -- * Creating new units - Unit(type BaseUnit, type DimOfUnit, conversionRatio), + Unit(type BaseUnit, type DimOfUnit, conversionRatio), Canonical, -- * Numbers, the only built-in unit @@ -297,7 +301,7 @@ -- -- or -- --- > inMeters x = x # Meter +-- > inMeters x = x # Meter numIn :: forall unit dim lcsu n. ( ValidDLU dim lcsu unit , VectorSpace n @@ -343,10 +347,10 @@ (%) = quOf -- | Dimension-keeping cast between different CSUs. -convert :: forall d l1 l2 n. +convert :: forall d l1 l2 n. ( ConvertibleLCSUs d l1 l2 , VectorSpace n - , Fractional (Scalar n) ) + , Fractional (Scalar n) ) => Qu d l1 n -> Qu d l2 n convert (Qu x) = Qu $ x ^* fromRational ( canonicalConvRatioSpec (Proxy :: Proxy (LookupList d l1)) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -36,8 +36,13 @@ conversion. Unit conversions are needed only when putting values in and out of quantities, or converting between two different CSUs. +Checking out units +------------------ +Units has a git submodule, so you'll want to use `git clone --recursive`. Example: + git clone --recursive https://github.com/goldfirere/units + User contributions ------------------ @@ -72,6 +77,12 @@ 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.Linear`__ + + This exports a set of definitions for interoperability with the `linear` + package. This is /not/ a top-level import; generally, import this with + `Data.Metrology.Poly` as well. - __`Data.Metrology.Internal`__ diff --git a/Tests/PhysicalConstants.hs b/Tests/PhysicalConstants.hs --- a/Tests/PhysicalConstants.hs +++ b/Tests/PhysicalConstants.hs @@ -1,7 +1,11 @@ {-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, TypeFamilies, - TypeOperators, ImplicitParams #-} + TypeOperators, ImplicitParams, CPP #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} +#if __GLASGOW_HASKELL__ >= 711 +{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} +#endif + module Tests.PhysicalConstants where import Data.Metrology.Poly @@ -75,15 +79,15 @@ -- eps0 vacuumPermittivity :: CompatibleUnit l SIPermittivityUnit => MkQu_UL SIPermittivityUnit l -vacuumPermittivity = +vacuumPermittivity = (1 / (4 * pi * 1e-7 * 299792458**2)) % (undefined :: SIPermittivityUnit) --- mu0 -vacuumPermeability :: CompatibleUnit l SIPermeabilityUnit +-- mu0 +vacuumPermeability :: CompatibleUnit l SIPermeabilityUnit => MkQu_UL SIPermeabilityUnit l vacuumPermeability = (4 * pi * 1e-7) % (undefined :: SIPermeabilityUnit) -- |Planck constant -planckConstant :: CompatibleUnit l JouleSecond +planckConstant :: CompatibleUnit l JouleSecond => MkQu_UL JouleSecond l planckConstant = (6.6260695729e-34) % (undefined :: JouleSecond) @@ -108,5 +112,3 @@ 1.616199256057012e-35 m -} - - diff --git a/units-defs/Data/Units/CGS.hs b/units-defs/Data/Units/CGS.hs --- a/units-defs/Data/Units/CGS.hs +++ b/units-defs/Data/Units/CGS.hs @@ -10,14 +10,14 @@ -- Stability : experimental -- Portability : non-portable -- --- This module defines units used in the centimeter/gram/second system +-- This module defines units used in the centimeter\/gram\/second system -- of measurement. -- -- Included are all mechanical units mentioned here: --- http://en.wikipedia.org/wiki/Centimetre%E2%80%93gram%E2%80%93second_system_of_units +-- -- -- Some electromagnetic units are not included, because these do not have --- reliable conversions to/from the SI units, on which the @units-defs@ +-- reliable conversions to\/from the SI units, on which the @units-defs@ -- edifice is based. ----------------------------------------------------------------------------- diff --git a/units-defs/Data/Units/US.hs b/units-defs/Data/Units/US.hs --- a/units-defs/Data/Units/US.hs +++ b/units-defs/Data/Units/US.hs @@ -17,13 +17,13 @@ -- want the foot-pound-second system, use the 'FPS'. -- -- Included are all units mentioned here: --- http://en.wikipedia.org/wiki/United_States_customary_units +-- -- Where possible, conversion rates have been independently verified -- at a US government website. However, Wikipedia's base is /much/ -- better organized than any government resource immediately available. -- The US government references used are as follows: --- http://nist.gov/pml/wmd/metric/upload/SP1038.pdf --- http://nist.gov/pml/wmd/pubs/upload/appc-14-hb44-final.pdf +-- +-- ----------------------------------------------------------------------------- module Data.Units.US ( diff --git a/units-defs/Data/Units/US/Apothecaries.hs b/units-defs/Data/Units/US/Apothecaries.hs --- a/units-defs/Data/Units/US/Apothecaries.hs +++ b/units-defs/Data/Units/US/Apothecaries.hs @@ -13,13 +13,13 @@ -- are rarely used. -- -- Included are all units mentioned here: --- http://en.wikipedia.org/wiki/United_States_customary_units +-- -- Where possible, conversion rates have been independently verified -- at a US government website. However, Wikipedia's base is /much/ -- better organized than any government resource immediately available. -- The US government references used are as follows: --- http://nist.gov/pml/wmd/metric/upload/SP1038.pdf --- http://nist.gov/pml/wmd/pubs/upload/appc-14-hb44-final.pdf +-- +-- ----------------------------------------------------------------------------- module Data.Units.US.Apothecaries ( diff --git a/units-defs/Data/Units/US/Avoirdupois.hs b/units-defs/Data/Units/US/Avoirdupois.hs --- a/units-defs/Data/Units/US/Avoirdupois.hs +++ b/units-defs/Data/Units/US/Avoirdupois.hs @@ -13,13 +13,13 @@ -- system is the one most commonly used in the US. -- -- Included are all units mentioned here: --- http://en.wikipedia.org/wiki/United_States_customary_units +-- -- Where possible, conversion rates have been independently verified -- at a US government website. However, Wikipedia's base is /much/ -- better organized than any government resource immediately available. -- The US government references used are as follows: --- http://nist.gov/pml/wmd/metric/upload/SP1038.pdf --- http://nist.gov/pml/wmd/pubs/upload/appc-14-hb44-final.pdf +-- +-- ----------------------------------------------------------------------------- module Data.Units.US.Avoirdupois where diff --git a/units-defs/Data/Units/US/DryVolume.hs b/units-defs/Data/Units/US/DryVolume.hs --- a/units-defs/Data/Units/US/DryVolume.hs +++ b/units-defs/Data/Units/US/DryVolume.hs @@ -12,13 +12,13 @@ -- This module defines dry volume measures as used in the USA. -- -- Included are all units mentioned here: --- http://en.wikipedia.org/wiki/United_States_customary_units +-- -- Where possible, conversion rates have been independently verified -- at a US government website. However, Wikipedia's base is /much/ -- better organized than any government resource immediately available. -- The US government references used are as follows: --- http://nist.gov/pml/wmd/metric/upload/SP1038.pdf --- http://nist.gov/pml/wmd/pubs/upload/appc-14-hb44-final.pdf +-- +-- ----------------------------------------------------------------------------- module Data.Units.US.DryVolume where diff --git a/units-defs/Data/Units/US/Liquid.hs b/units-defs/Data/Units/US/Liquid.hs --- a/units-defs/Data/Units/US/Liquid.hs +++ b/units-defs/Data/Units/US/Liquid.hs @@ -14,13 +14,13 @@ -- in the USA and from liquid volumes in the UK. -- -- Included are all units mentioned here: --- http://en.wikipedia.org/wiki/United_States_customary_units +-- -- Where possible, conversion rates have been independently verified -- at a US government website. However, Wikipedia's base is /much/ -- better organized than any government resource immediately available. -- The US government references used are as follows: --- http://nist.gov/pml/wmd/metric/upload/SP1038.pdf --- http://nist.gov/pml/wmd/pubs/upload/appc-14-hb44-final.pdf +-- +-- ----------------------------------------------------------------------------- module Data.Units.US.Liquid where @@ -49,7 +49,7 @@ declareDerivedUnit "Barrel" [t| Hogshead |] (1/2) (Just "bbl") declareDerivedUnit "OilBarrel" [t| Gallon |] 42 (Just "bbl") --- | As shown on Wikipedia: http://en.wikipedia.org/wiki/United_States_customary_units +-- | As shown on Wikipedia: commonLiquidMeasures :: [Name] commonLiquidMeasures = [ ''Teaspoon, ''Tablespoon, ''FluidOunce, ''Cup, ''Pint , ''Quart, ''Gallon ] diff --git a/units-defs/Data/Units/US/Misc.hs b/units-defs/Data/Units/US/Misc.hs --- a/units-defs/Data/Units/US/Misc.hs +++ b/units-defs/Data/Units/US/Misc.hs @@ -13,13 +13,13 @@ -- other categories. -- -- Included are all units mentioned here: --- http://en.wikipedia.org/wiki/United_States_customary_units +-- -- Where possible, conversion rates have been independently verified -- at a US government website. However, Wikipedia's base is /much/ -- better organized than any government resource immediately available. -- The US government references used are as follows: --- http://nist.gov/pml/wmd/metric/upload/SP1038.pdf --- http://nist.gov/pml/wmd/pubs/upload/appc-14-hb44-final.pdf +-- +-- ----------------------------------------------------------------------------- module Data.Units.US.Misc ( diff --git a/units-defs/Data/Units/US/Survey.hs b/units-defs/Data/Units/US/Survey.hs --- a/units-defs/Data/Units/US/Survey.hs +++ b/units-defs/Data/Units/US/Survey.hs @@ -14,13 +14,13 @@ -- foot. -- -- Included are all units mentioned here: --- http://en.wikipedia.org/wiki/United_States_customary_units +-- -- Where possible, conversion rates have been independently verified -- at a US government website. However, Wikipedia's base is /much/ -- better organized than any government resource immediately available. -- The US government references used are as follows: --- http://nist.gov/pml/wmd/metric/upload/SP1038.pdf --- http://nist.gov/pml/wmd/pubs/upload/appc-14-hb44-final.pdf +-- +-- ----------------------------------------------------------------------------- module Data.Units.US.Survey where diff --git a/units-defs/Data/Units/US/Troy.hs b/units-defs/Data/Units/US/Troy.hs --- a/units-defs/Data/Units/US/Troy.hs +++ b/units-defs/Data/Units/US/Troy.hs @@ -13,13 +13,13 @@ -- system is most often used when measuring precious metals. -- -- Included are all units mentioned here: --- http://en.wikipedia.org/wiki/United_States_customary_units +-- -- Where possible, conversion rates have been independently verified -- at a US government website. However, Wikipedia's base is /much/ -- better organized than any government resource immediately available. -- The US government references used are as follows: --- http://nist.gov/pml/wmd/metric/upload/SP1038.pdf --- http://nist.gov/pml/wmd/pubs/upload/appc-14-hb44-final.pdf +-- +-- ----------------------------------------------------------------------------- module Data.Units.US.Troy ( diff --git a/units.cabal b/units.cabal --- a/units.cabal +++ b/units.cabal @@ -1,5 +1,5 @@ name: units -version: 2.3 +version: 2.4 cabal-version: >= 1.10 synopsis: A domain-specific type system for dimensional analysis homepage: https://github.com/goldfirere/units @@ -46,7 +46,7 @@ source-repository this type: git location: https://github.com/goldfirere/units.git - tag: v2.3 + tag: v2.4 library ghc-options: -Wall @@ -56,22 +56,26 @@ build-depends: base >= 4.7 && < 5 , th-desugar >= 1.5.4 - , singletons >= 0.9 && < 2 + , singletons >= 0.9 && < 3 , vector-space >= 0.8 + , linear >= 1.16.2 , template-haskell , mtl >= 1.1 , multimap >= 1.2 , syb >= 0.3 , containers >= 0.4 , units-parser >= 0.1 && < 1.0 - exposed-modules: - Data.Metrology, + , lens >= 4 && < 5 + , deepseq >= 1.1.0.0 && < 1.5 + exposed-modules: + Data.Metrology, Data.Metrology.Internal, Data.Metrology.Show, Data.Metrology.Unsafe, Data.Metrology.Z, Data.Metrology.Set, Data.Metrology.Vector, + Data.Metrology.Linear, Data.Metrology.Parser, Data.Metrology.Poly, Data.Metrology.TH, @@ -97,8 +101,9 @@ build-depends: units , base >= 4.7 && < 5 , th-desugar >= 1.5.4 - , singletons >= 0.9 && < 2 + , singletons >= 0.9 && < 3 , vector-space >= 0.8 + , linear >= 1.16.2 , tasty >= 0.8 , tasty-hunit >= 0.8 , HUnit-approx >= 1.0 @@ -108,12 +113,16 @@ , syb >= 0.3 , containers >= 0.4 , units-parser >= 0.1 && < 1.0 + , lens >= 4 && < 5 + , deepseq >= 1.1.0.0 && < 1.5 hs-source-dirs: units-defs, . -- optimize compile time, not runtime! ghc-options: -O0 -Wall -main-is Tests.Main if impl(ghc >= 7.10) ghc-options: -fno-warn-unticked-promoted-constructors + if impl(ghc >= 8.0) + ghc-options: -Wno-missing-signatures -Wno-redundant-constraints -Wno-name-shadowing -Wno-missing-pattern-synonym-signatures -- GHC 7.10 requires this in more places, and I don't feel like ferreting out exactly -- where.