diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,21 @@ Release notes for `units` ========================= +Version 2.3 +----------- +* `Data.Metrology.TH.evalType` now works in GHC 7.10 on dimensions like `Volume` instead +of just base dimensions. + +* Break out the units parser into its own package: `units-parser`. + +* Add `Data.Metrology.Unsafe.UnsafeQu`, which has `Functor` and other +instances. + +* Fix the fixity of `%`. It was way too high! Now it's 5. + +* Add the ability to convert in and out of point quantities. See `quOfPoint` +and friends in `Data.Metrology.Vector`. + Version 2.2.1 ------------- diff --git a/Data/Metrology.hs b/Data/Metrology.hs --- a/Data/Metrology.hs +++ b/Data/Metrology.hs @@ -100,7 +100,7 @@ => n -> unit -> Qu dim DefaultLCSU n quOf = Poly.quOf -infixr 9 % +infixr 5 % -- | Infix synonym for 'quOf' (%) :: ( ValidDLU dim DefaultLCSU unit , Fractional n ) diff --git a/Data/Metrology/Parser.hs b/Data/Metrology/Parser.hs --- a/Data/Metrology/Parser.hs +++ b/Data/Metrology/Parser.hs @@ -70,7 +70,7 @@ import Data.Maybe import Control.Monad -import Data.Metrology.Parser.Internal +import Text.Parse.Units import Data.Metrology import Data.Metrology.TH diff --git a/Data/Metrology/Parser/Internal.hs b/Data/Metrology/Parser/Internal.hs deleted file mode 100644 --- a/Data/Metrology/Parser/Internal.hs +++ /dev/null @@ -1,350 +0,0 @@ -{- units Package - Copyright (c) 2014 Richard Eisenberg - - This file defines a parser for unit expressions. --} - -{-# LANGUAGE LambdaCase, NoMonomorphismRestriction, - FlexibleContexts, RankNTypes, Safe #-} - -module Data.Metrology.Parser.Internal ( - UnitExp(..), parseUnit, - - 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 - ----------------------------------------------------------------------- --- 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 - diff --git a/Data/Metrology/Poly.hs b/Data/Metrology/Poly.hs --- a/Data/Metrology/Poly.hs +++ b/Data/Metrology/Poly.hs @@ -164,7 +164,7 @@ (canonicalConvRatio u / canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu)))) -infixr 9 % +infix 5 % -- | Infix synonym for 'quOf' (%) :: ( ValidDLU dim lcsu unit , Fractional n ) diff --git a/Data/Metrology/TH.hs b/Data/Metrology/TH.hs --- a/Data/Metrology/TH.hs +++ b/Data/Metrology/TH.hs @@ -18,14 +18,14 @@ evalType, declareDimension, declareCanonicalUnit, declareDerivedUnit, declareMonoUnit, declareConstant, - + -- for internal use only - checkIsType + checkIsType ) where import Language.Haskell.TH import Language.Haskell.TH.Desugar ( dsType, sweeten ) -import Language.Haskell.TH.Desugar.Expand ( expandType ) +import Language.Haskell.TH.Desugar.Expand ( expandUnsoundly ) import Language.Haskell.TH.Desugar.Lift () -- need Lift Rational import Data.Metrology.Dimensions @@ -46,15 +46,12 @@ -- will be evaluated, and the instance declaration will fail. This function -- should never cause /incorrect/ behavior.) -- --- Note: Under GHC 7.10 and later, this function works only for base types --- like @Length@, not compound types like @Volume@ or @Velocity@. See --- for more info and a --- workaround. evalType :: Q Type -> Q Type evalType qty = do ty <- qty dty <- dsType ty - ex_dty <- expandType dty + ex_dty <- expandUnsoundly dty + -- NB: No units type families branch on kind variables, so this is safe here. return $ sweeten ex_dty -- Checks to make sure the given name names a /type/, not a /data constructor/. diff --git a/Data/Metrology/Unsafe.hs b/Data/Metrology/Unsafe.hs --- a/Data/Metrology/Unsafe.hs +++ b/Data/Metrology/Unsafe.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Unsafe #-} +{-# LANGUAGE Unsafe, CPP #-} ----------------------------------------------------------------------------- -- | @@ -12,12 +12,42 @@ -- This module exports the constructor of the 'Qu' type. This allows you -- to write code that takes creates and reads quantities at will, -- which may lead to dimension unsafety. Use at your peril. +-- +-- This module also exports 'UnsafeQu', which is a simple wrapper around +-- 'Qu' that has 'Functor', etc., instances. The reason 'Qu' itself doesn't +-- have a 'Functor' instance is that it would be unit-unsafe, allowing you, +-- say, to add 1 to a quantity.... but 1 what? That's the problem. However, +-- a 'Functor' instance is likely useful, hence 'UnsafeQu'. ----------------------------------------------------------------------------- module Data.Metrology.Unsafe ( - -- * The 'Dim' type + -- * The 'Qu' type Qu(..), + + -- * 'UnsafeQu' + UnsafeQu(..) ) where import Data.Metrology.Qu +#if __GLASGOW_HASKELL__ < 709 +import Control.Applicative +import Data.Foldable +import Data.Traversable +#endif + +-- | A basic wrapper around 'Qu' that has more instances. +newtype UnsafeQu d l n = UnsafeQu { qu :: Qu d l n } + +instance Functor (UnsafeQu d l) where + fmap f (UnsafeQu (Qu x)) = UnsafeQu (Qu (f x)) + +instance Applicative (UnsafeQu d l) where + pure x = UnsafeQu (Qu x) + UnsafeQu (Qu f) <*> UnsafeQu (Qu x) = UnsafeQu (Qu (f x)) + +instance Foldable (UnsafeQu d l) where + foldMap f (UnsafeQu (Qu x)) = f x + +instance Traversable (UnsafeQu d l) where + traverse f (UnsafeQu (Qu x)) = UnsafeQu . Qu <$> f x diff --git a/Data/Metrology/Vector.hs b/Data/Metrology/Vector.hs --- a/Data/Metrology/Vector.hs +++ b/Data/Metrology/Vector.hs @@ -42,6 +42,7 @@ -- ** Affine operations Point(..), QPoint, (|.-.|), (|.+^|), (|.-^|), qDistanceSq, qDistance, + pointNumIn, (.#), quOfPoint, (%.), -- ** Comparison qCompare, (|<|), (|>|), (|<=|), (|>=|), (|==|), (|/=|), @@ -229,6 +230,37 @@ (.-.) = coerce ((^-^) :: n -> n -> n) (.+^) = coerce ((^+^) :: n -> n -> n) +-- | Make a point quantity at the given unit. Like 'quOf'. +quOfPoint :: forall dim lcsu unit n. + ( ValidDLU dim lcsu unit + , VectorSpace n + , Fractional (Scalar n) ) + => n -> unit -> Qu dim lcsu (Point n) +quOfPoint n unit = Qu (Point x) + where Qu x = quOf n unit :: Qu dim lcsu n + +infix 5 %. +-- | Infix synonym of 'quOfPoint' +(%.) :: ( ValidDLU dim lcsu unit + , VectorSpace n + , Fractional (Scalar n) ) + => n -> unit -> Qu dim lcsu (Point n) +(%.) = quOfPoint + +-- | Extract the numerical value from a point quantity. Like 'numIn'. +pointNumIn :: forall unit dim lcsu n. + ( ValidDLU dim lcsu unit + , VectorSpace n + , Fractional (Scalar n) ) + => Qu dim lcsu (Point n) -> unit -> n +pointNumIn (Qu (Point n)) unit = numIn (Qu n :: Qu dim lcsu n) unit + +infix 5 .# +-- | Infix synonym for 'pointNumIn'. +(.#) :: (ValidDLU dim lcsu unit, VectorSpace n, Fractional (Scalar n)) + => Qu dim lcsu (Point n) -> unit -> n +(.#) = pointNumIn + infixl 6 |.-.|, |.+^|, |.-^| -- | Subtract point quantities. @@ -302,7 +334,7 @@ (canonicalConvRatio u / canonicalConvRatioSpec (Proxy :: Proxy (LookupList dim lcsu)))) -infixr 9 % +infix 5 % -- | Infix synonym for 'quOf' (%) :: ( ValidDLU dim lcsu unit , VectorSpace n diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -11,7 +11,7 @@ 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 +may be measured by many different units. For example, both meters and feet measure length. The package supports defining multiple inter-convertible units of the same @@ -131,7 +131,7 @@ 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 +physical quantities, you may want to check `Data.Dimensions.SI` in the `units-defs` package first.) data LengthDim = LengthDim -- each dimension is a datatype that acts as its own proxy @@ -418,4 +418,4 @@ 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). +[here](https://github.com/goldfirere/units/tree/master/Tests). diff --git a/Tests/Compile/CGS.hs b/Tests/Compile/CGS.hs --- a/Tests/Compile/CGS.hs +++ b/Tests/Compile/CGS.hs @@ -4,7 +4,7 @@ import Data.Metrology import Data.Metrology.SI -import qualified Data.Metrology.SI.Dims as D +import qualified Data.Dimensions.SI as D type CGS = MkLCSU '[ (D.Length, Centi :@ Meter) , (D.Mass, Gram) diff --git a/Tests/Compile/Physics.hs b/Tests/Compile/Physics.hs --- a/Tests/Compile/Physics.hs +++ b/Tests/Compile/Physics.hs @@ -3,11 +3,11 @@ module Tests.Compile.Physics where +import Data.Dimensions.SI 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 Data.Units.SI +import Data.Units.SI.Prefixes import Tests.Compile.CGS type Position = Length diff --git a/Tests/LennardJones.hs b/Tests/LennardJones.hs --- a/Tests/LennardJones.hs +++ b/Tests/LennardJones.hs @@ -12,10 +12,10 @@ 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.Units.SI +import Data.Units.SI.Prefixes +import qualified Data.Dimensions.SI as D -- import Data.Metrology.Show import Test.Tasty diff --git a/Tests/OffSystemAdd.hs b/Tests/OffSystemAdd.hs --- a/Tests/OffSystemAdd.hs +++ b/Tests/OffSystemAdd.hs @@ -5,7 +5,7 @@ import Data.Metrology.Poly import Data.Metrology.SI -import qualified Data.Metrology.SI.Dims as D +import qualified Data.Dimensions.SI as D import Test.Tasty import Test.Tasty.HUnit diff --git a/Tests/OffSystemCSU.hs b/Tests/OffSystemCSU.hs --- a/Tests/OffSystemCSU.hs +++ b/Tests/OffSystemCSU.hs @@ -5,7 +5,7 @@ import Data.Metrology.Poly import Data.Metrology.SI -import qualified Data.Metrology.SI.Dims as D +import qualified Data.Dimensions.SI as D import Test.Tasty.HUnit import Test.HUnit.Approx diff --git a/Tests/Parser.hs b/Tests/Parser.hs --- a/Tests/Parser.hs +++ b/Tests/Parser.hs @@ -9,12 +9,8 @@ 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 @@ -35,84 +31,6 @@ 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) @@ -206,9 +124,6 @@ tests :: TestTree tests = testGroup "Parser" - [ lexTests - , mkSymbolTableTests - , unitStringTests - , parseUnitTests + [ parseUnitTests , parseUnitTestsT ] diff --git a/Tests/PhysicalConstants.hs b/Tests/PhysicalConstants.hs --- a/Tests/PhysicalConstants.hs +++ b/Tests/PhysicalConstants.hs @@ -7,7 +7,7 @@ import Data.Metrology.Poly import Data.Metrology.Show () import Data.Metrology.SI.Poly -import qualified Data.Metrology.SI.Dims as D +import qualified Data.Dimensions.SI as D import Tests.Compile.MetrologySynonyms diff --git a/Tests/Travel.hs b/Tests/Travel.hs --- a/Tests/Travel.hs +++ b/Tests/Travel.hs @@ -7,10 +7,11 @@ import Data.Metrology.Poly import Data.Metrology.SI.Poly -import Data.Metrology.Imperial.Types (Imperial) -import Data.Metrology.Imperial.Units +-- import Data.Metrology.Imperial.Types (Imperial) +-- import Data.Metrology.Imperial.Units +import Data.Units.US (Gallon(..), Mile(..), Pound(..), Yard) import Data.Metrology.Show () -import qualified Data.Metrology.SI.Dims as D +import qualified Data.Dimensions.SI as D import Test.Tasty import Test.Tasty.HUnit @@ -18,6 +19,38 @@ type PerArea lcsu n = MkQu_DLN (D.Area :^ MOne) lcsu n +-- import the Imperial type from version 1.1 of +-- unit-defs/Data.Metrology.Imperial.Types +-- +-- The old version seems to have had 1 Gallon be 0.00454609 m^3, +-- but version 2.0 of units-defs has 1 Gallon be 231 inch^3 +-- +-- 231 inch^3 = 231 * (0.0254^3) m^3 +-- = 0.00378542 +-- +-- and +-- +-- 0.00454609 / 0.00378542 = 1.200947 +-- +-- so I use this value to scale the answers below +-- + +gallonChange :: Float +gallonChange = 231 * (0.0254 ** 3) / 0.00454609 + +type Imperial = + MkLCSU + '[ (D.Length, Yard) + , (D.Mass, Pound) + , (D.Time, Second) + {- Not needed by these tests + , (D.Current, Ampere) + , (D.Temperature, Kelvin) + , (D.AmountOfSubstance, Mole) + , (D.LuminousIntensity, Candela) + -} + ] + fromGLtoED :: MkQu_DLN D.Length Imperial Float fromGLtoED = 46.5 % Mile @@ -40,8 +73,8 @@ , 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 "fuelEfficiency2" (fuelEfficiency # (kilo Meter :/ Liter) @?~ (14.160248 / gallonChange)) + , testCase "gasolineDensity2" (gasolineDensity # (kilo Gram :/ Liter) @?~ (0.7273698 / gallonChange)) , testCase "gasolineWeight2" ((gasolineWeight (convert fromGLtoED) (convert fuelEfficiency) (convert gasolineDensity) :: MkQu_DLN D.Mass SI Float) # kilo Gram @?~ 3.8440251) ] main :: IO () @@ -57,7 +90,6 @@ 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 diff --git a/units-defs/Data/Constants/Math.hs b/units-defs/Data/Constants/Math.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Constants/Math.hs @@ -0,0 +1,19 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Constants.Math +-- Copyright : (C) 2014 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (eir@cis.upenn.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Approximates mathematical constants as 'Rational's +----------------------------------------------------------------------------- + +module Data.Constants.Math where + +piR :: Rational +piR = 3.1415926535897932384626433832795028841971693993751058209749445923078164 + +eR :: Rational +eR = 2.71828182845904523536028747135266249775724709369995957496696762772407663 diff --git a/units-defs/Data/Constants/Mechanics.hs b/units-defs/Data/Constants/Mechanics.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Constants/Mechanics.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE TypeOperators, ConstraintKinds, TemplateHaskell #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Constants.Mechanics +-- Copyright : (C) 2014 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (eir@cis.upenn.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- This file defines dimensioned physical constants, useful in mechanics. +-- +-- The names used are a short description of the constant followed by its +-- usual symbol, separated by an underscore. For non-Latin symbols, the +-- Latin-lettered transliteration of the symbol name is used. +----------------------------------------------------------------------------- + +module Data.Constants.Mechanics where + +import Data.Metrology.Poly +import Data.Metrology.SI.Poly +import Data.Metrology.TH + +-- | Acceleration at Earth's surface due to gravity. +declareConstant "gravity_g" 9.80665 [t| Meter :/ Second :^ Two |] diff --git a/units-defs/Data/Dimensions/SI.hs b/units-defs/Data/Dimensions/SI.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Dimensions/SI.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE TypeOperators, TemplateHaskell #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Dimensions.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 defines SI dimensions. The names of SI dimensions conform to +-- . +----------------------------------------------------------------------------- + +module Data.Dimensions.SI where + +import Data.Metrology.Poly +import Data.Metrology.TH + +declareDimension "Length" +declareDimension "Mass" +declareDimension "Time" +declareDimension "Current" +declareDimension "Temperature" +declareDimension "AmountOfSubstance" +declareDimension "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 diff --git a/units-defs/Data/Metrology/Imperial/Types.hs b/units-defs/Data/Metrology/Imperial/Types.hs deleted file mode 100644 --- a/units-defs/Data/Metrology/Imperial/Types.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-# 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 diff --git a/units-defs/Data/Metrology/Imperial/Units.hs b/units-defs/Data/Metrology/Imperial/Units.hs deleted file mode 100644 --- a/units-defs/Data/Metrology/Imperial/Units.hs +++ /dev/null @@ -1,112 +0,0 @@ -{-# 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: . --- ------------------------------------------------------------------------------ - -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" - - - diff --git a/units-defs/Data/Metrology/SI.hs b/units-defs/Data/Metrology/SI.hs --- a/units-defs/Data/Metrology/SI.hs +++ b/units-defs/Data/Metrology/SI.hs @@ -17,9 +17,7 @@ ----------------------------------------------------------------------------- module Data.Metrology.SI ( - module Data.Metrology.SI.Mono + module Data.Metrology.SI.Mono, ) where import Data.Metrology.SI.Mono - - diff --git a/units-defs/Data/Metrology/SI/Dims.hs b/units-defs/Data/Metrology/SI/Dims.hs deleted file mode 100644 --- a/units-defs/Data/Metrology/SI/Dims.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# 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 --- . ------------------------------------------------------------------------------ - -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 diff --git a/units-defs/Data/Metrology/SI/Mono.hs b/units-defs/Data/Metrology/SI/Mono.hs --- a/units-defs/Data/Metrology/SI/Mono.hs +++ b/units-defs/Data/Metrology/SI/Mono.hs @@ -11,22 +11,25 @@ -- -- This module exports definitions for the SI system, with the intent -- of using these definitions in a monomorphic manner -- that is, --- with the DefaultLCSU. +-- with the DefaultLCSU. The difference between this module and +-- 'Data.Metrology.SI.MonoTypes' is that this module also exports +-- instances of 'DefaultUnitOfDim', necessary for use with +-- '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 + module Data.Units.SI, + module Data.Units.SI.Prefixes, + module Data.Units.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.Units.SI +import Data.Units.SI.Prefixes +import qualified Data.Dimensions.SI as D import Data.Metrology -import Data.Metrology.SI.Parser +import Data.Units.SI.Parser type instance DefaultUnitOfDim D.Length = Meter type instance DefaultUnitOfDim D.Mass = Kilo :@ Gram diff --git a/units-defs/Data/Metrology/SI/MonoTypes.hs b/units-defs/Data/Metrology/SI/MonoTypes.hs --- a/units-defs/Data/Metrology/SI/MonoTypes.hs +++ b/units-defs/Data/Metrology/SI/MonoTypes.hs @@ -10,13 +10,14 @@ -- Portability : non-portable -- -- This module defines type synonyms for SI units, using a Double as the --- internal representation. +-- internal representation. This module /does not/ export instances of +-- 'DefaultUnitOfDim'. Use 'Data.Metrology.SI.Mono' for that. ----------------------------------------------------------------------------- module Data.Metrology.SI.MonoTypes where import Data.Metrology -import qualified Data.Metrology.SI.Dims as D +import qualified Data.Dimensions.SI as D type Length = MkQu_D D.Length type Mass = MkQu_D D.Mass diff --git a/units-defs/Data/Metrology/SI/Parser.hs b/units-defs/Data/Metrology/SI/Parser.hs deleted file mode 100644 --- a/units-defs/Data/Metrology/SI/Parser.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# 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 diff --git a/units-defs/Data/Metrology/SI/Poly.hs b/units-defs/Data/Metrology/SI/Poly.hs --- a/units-defs/Data/Metrology/SI/Poly.hs +++ b/units-defs/Data/Metrology/SI/Poly.hs @@ -17,17 +17,17 @@ 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 + module Data.Units.SI.Prefixes, + module Data.Units.SI, + module Data.Units.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.Units.SI.Prefixes +import Data.Units.SI +import qualified Data.Dimensions.SI as D import Data.Metrology -import Data.Metrology.SI.Parser +import Data.Units.SI.Parser type SI = MkLCSU '[ (D.Length, Meter) , (D.Mass, Kilo :@ Gram) diff --git a/units-defs/Data/Metrology/SI/PolyTypes.hs b/units-defs/Data/Metrology/SI/PolyTypes.hs --- a/units-defs/Data/Metrology/SI/PolyTypes.hs +++ b/units-defs/Data/Metrology/SI/PolyTypes.hs @@ -16,7 +16,7 @@ module Data.Metrology.SI.PolyTypes where import Data.Metrology -import qualified Data.Metrology.SI.Dims as D +import qualified Data.Dimensions.SI as D type Length = MkQu_DLN D.Length type Mass = MkQu_DLN D.Mass diff --git a/units-defs/Data/Metrology/SI/Prefixes.hs b/units-defs/Data/Metrology/SI/Prefixes.hs deleted file mode 100644 --- a/units-defs/Data/Metrology/SI/Prefixes.hs +++ /dev/null @@ -1,227 +0,0 @@ -{-# 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 ------------------------------------------------------------------------------ - -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 - ] diff --git a/units-defs/Data/Metrology/SI/Units.hs b/units-defs/Data/Metrology/SI/Units.hs deleted file mode 100644 --- a/units-defs/Data/Metrology/SI/Units.hs +++ /dev/null @@ -1,266 +0,0 @@ -{-# 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: . --- --- Some additional units were added base on --- : --- "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 - ] - diff --git a/units-defs/Data/Units/CGS.hs b/units-defs/Data/Units/CGS.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/CGS.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE PatternSynonyms, TemplateHaskell, TypeOperators, + TypeFamilies #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.CGS +-- Copyright : (C) 2014 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (eir@cis.upenn.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- 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@ +-- edifice is based. +----------------------------------------------------------------------------- + +module Data.Units.CGS ( + Centi(..), centi, Meter(..), pattern Metre, Gram(..), Second(..), + module Data.Units.CGS + ) where + +import Data.Units.SI +import Data.Units.SI.Prefixes +import Data.Metrology.Poly +import Data.Metrology.TH + +type Centimeter = Centi :@ Meter +pattern Centimeter = Centi :@ Meter + +type Centimetre = Centimeter +pattern Centimetre = Centimeter + +declareDerivedUnit "Gal" + [t| Centimeter :/ Second :^ Two |] 1 (Just "Gal") +declareDerivedUnit "Dyne" + [t| Gram :* Centimeter :/ Second :^ Two |] 1 (Just "dyn") +declareDerivedUnit "Erg" + [t| Gram :* Centimeter :^ Two :/ Second :^ Two |] 1 (Just "erg") +declareDerivedUnit "Barye" + [t| Gram :/ (Centimeter :* Second :^ Two) |] 1 (Just "Ba") +declareDerivedUnit "Poise" + [t| Gram :/ (Centimeter :* Second) |] 1 (Just "P") +declareDerivedUnit "Stokes" + [t| Centimeter :^ Two :/ Second |] 1 (Just "St") +declareDerivedUnit "Kayser" + [t| Centimeter :^ MOne |] 1 Nothing + +declareDerivedUnit "Maxwell" [t| Nano :@ Weber |] 10 (Just "Mx") +declareDerivedUnit "Gauss" [t| Milli :@ Tesla |] 0.1 (Just "G") diff --git a/units-defs/Data/Units/PreciousMetals.hs b/units-defs/Data/Units/PreciousMetals.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/PreciousMetals.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Metrology.Units.PreciousMetals +-- Copyright : (C) 2013 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (eir@cis.upenn.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Units used in the measure of precious metals. +----------------------------------------------------------------------------- + +module Data.Units.PreciousMetals where + +import Data.Metrology +import Data.Metrology.TH +import Data.Units.SI +import Data.Units.SI.Prefixes + +import qualified Data.Units.US.Avoirdupois as Avdp +import qualified Data.Units.US.Troy as Troy + +declareDerivedUnit "Carat" [t| Milli :@ Gram |] 200 (Just "carat") +declareDerivedUnit "Point" [t| Carat |] 0.01 (Just "point") +declareDerivedUnit "AssayTon" [t| (Milli :@ Gram) :* (Avdp.Ton :/ Troy.Ounce) |] + 1 (Just "AT") diff --git a/units-defs/Data/Units/SI.hs b/units-defs/Data/Units/SI.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/SI.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE TypeFamilies, TypeOperators, PatternSynonyms, TemplateHaskell #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.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 definitions according to the SI system of units. +-- The definitions were taken from here: . +-- +-- Some additional units were added based on +-- : +-- "Non-SI units accepted for use with the SI, +-- and units based on fundamental constants". +-- +-- There is one deviation from the definitions 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.Units.SI where + +import Data.Metrology.Poly +import Data.Metrology.TH +import Data.Dimensions.SI +import Data.Units.SI.Prefixes ( Kilo, Centi ) + +import Language.Haskell.TH ( Name ) + +declareCanonicalUnit "Meter" [t| Length |] (Just "m") + +type Metre = Meter +pattern Metre = Meter + +declareCanonicalUnit "Gram" [t| Mass |] (Just "g") + +type Gramme = Gram +pattern Gramme = Gram + +declareCanonicalUnit "Second" [t| Time |] (Just "s") + +-- | Derived SI unit +declareDerivedUnit "Minute" [t| Second |] 60 (Just "min") + +-- | Derived SI unit +declareDerivedUnit "Hour" [t| Minute |] 60 (Just "h") + +declareCanonicalUnit "Ampere" [t| Current |] (Just "A") +declareCanonicalUnit "Kelvin" [t| Temperature |] (Just "K") +declareCanonicalUnit "Mole" [t| AmountOfSubstance |] (Just "mol") +declareCanonicalUnit "Candela" [t| LuminousIntensity |] (Just "cd") + +declareDerivedUnit "Hertz" [t| Number :/ Second |] 1 (Just "Hz") + +-- | This is not in the SI standard, but is used widely. +declareDerivedUnit "Liter" [t| (Centi :@ Meter) :^ Three |] 1000 (Just "L") + +type Litre = Liter +pattern Litre = Liter + +declareDerivedUnit "Newton" [t| Gram :* Meter :/ (Second :^ Two) |] 1000 (Just "N") +declareDerivedUnit "Pascal" [t| Newton :/ (Meter :^ Two) |] 1 (Just "Pa") +declareDerivedUnit "Joule" [t| Newton :* Meter |] 1 (Just "J") +declareDerivedUnit "Watt" [t| Joule :/ Second |] 1 (Just "W") +declareDerivedUnit "Coulomb" [t| Ampere :* Second |] 1 (Just "C") +declareDerivedUnit "Volt" [t| Watt :/ Ampere |] 1 (Just "V") +declareDerivedUnit "Farad" [t| Coulomb :/ Volt |] 1 (Just "F") +declareDerivedUnit "Ohm" [t| Volt :/ Ampere |] 1 (Just "Ω") +declareDerivedUnit "Siemens" [t| Ampere :/ Volt |] 1 (Just "S") +declareDerivedUnit "Weber" [t| Volt :* Second |] 1 (Just "Wb") +declareDerivedUnit "Tesla" [t| Weber :/ (Meter :^ Two) |] 1 (Just "T") +declareDerivedUnit "Henry" [t| Weber :/ Ampere |] 1 (Just "H") +declareDerivedUnit "Lumen" [t| Candela |] 1 (Just "lm") +declareDerivedUnit "Lux" [t| Lumen :/ (Meter :^ Two) |] 1 (Just "lx") +declareDerivedUnit "Becquerel" [t| Number :/ Second |] 1 (Just "Bq") +declareDerivedUnit "Gray" [t| (Meter :^ Two) :/ (Second :^ Two) |] 1 (Just "Gy") +declareDerivedUnit "Sievert" [t| (Meter :^ Two) :/ (Second :^ Two) |] 1 (Just "Sv") +declareDerivedUnit "Katal" [t| Mole :/ Second |] 1 (Just "kat") + +-- | Derived SI unit +declareDerivedUnit "Hectare" [t| Meter :^ Two |] 10000 (Just "ha") + +-- | Derived SI unit +declareDerivedUnit "Ton" [t| Kilo :@ Gram |] 1000 (Just "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, ''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 + ] + diff --git a/units-defs/Data/Units/SI/Parser.hs b/units-defs/Data/Units/SI/Parser.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/SI/Parser.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE TemplateHaskell #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.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.Units.SI.Parser ( si ) where + +import Data.Metrology.Parser +import Data.Units.SI.Prefixes +import Data.Units.SI + +makeQuasiQuoter "si" siPrefixes siUnits diff --git a/units-defs/Data/Units/SI/Prefixes.hs b/units-defs/Data/Units/SI/Prefixes.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/SI/Prefixes.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE TypeOperators, TemplateHaskell #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.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 +----------------------------------------------------------------------------- + +module Data.Units.SI.Prefixes where + +import Language.Haskell.TH ( Name ) +import Data.Metrology.Poly + +-- | 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 + ] diff --git a/units-defs/Data/Units/US.hs b/units-defs/Data/Units/US.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/US.hs @@ -0,0 +1,62 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.US +-- 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 the American customary system of units. Because +-- there are some names that are conflicted, even within this system, +-- there are several modules underneath here, defining sub-parts of +-- the US system. This module gathers together a subjective set of +-- units users will commonly wish to use. It also exports type instances +-- 'DefaultUnitOfDim' that use the /SI/ internal representations. This +-- choice is made for inter-compatibility with SI computations. If you +-- 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 ( + -- * Lengths + Angstrom(..), Mil(..), Point(..), Pica(..), + Inch(..), Foot(..), Yard(..), Mile(..), NauticalMile(..), + + -- * Velocity + Knot(..), + + -- * Area + Survey.Acre(..), + + -- * Volume + -- | These are all /liquid/ measures. Solid measures are /different/. + Liq.Teaspoon(..), Liq.Tablespoon(..), Liq.FluidOunce(..), + Liq.Cup(..), Liq.Pint(..), Liq.Quart(..), Liq.Gallon(..), + + -- * Mass + -- | These are all in the avoirdupois system + Avdp.Ounce(..), Avdp.Pound(..), Avdp.Ton(..), + + -- * Pressure + Atmosphere(..), Bar(..), + + -- * Energy + FoodCalorie(..), Therm(..), Btu(..), + + -- * Power + Horsepower(..) + ) where + +import Data.Units.US.Misc +import qualified Data.Units.US.Survey as Survey +import qualified Data.Units.US.Liquid as Liq +import qualified Data.Units.US.Avoirdupois as Avdp diff --git a/units-defs/Data/Units/US/Apothecaries.hs b/units-defs/Data/Units/US/Apothecaries.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/US/Apothecaries.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.US.Apothecaries +-- 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 apothecaries' measures of mass. These measures +-- 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 ( + module Data.Units.US.Apothecaries, + + -- | The apothecaries' grain is the same as the avoirdupois grain. + Grain(..), + + -- | The apothecaries' ounce and pound are the troy ounce and pound. + Ounce(..), Pound(..) + ) where + +import Data.Metrology.TH +import Data.Units.US.Avoirdupois ( Grain(..) ) +import Data.Units.US.Troy ( Ounce(..), Pound(..) ) + +import Language.Haskell.TH + +declareDerivedUnit "Scruple" [t| Grain |] 20 (Just "sap") +declareDerivedUnit "Dram" [t| Grain |] 60 (Just "drap") + +-- | Includes 'Grain', 'Scruple', 'Dram', 'Ounce', and 'Pound'. +apothecariesMassMeasures :: [Name] +apothecariesMassMeasures = [ ''Grain, ''Scruple, ''Dram, ''Ounce, ''Pound ] diff --git a/units-defs/Data/Units/US/Avoirdupois.hs b/units-defs/Data/Units/US/Avoirdupois.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/US/Avoirdupois.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.US.Avoirdupois +-- 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 avoirdupois measures of mass. The avoirdupois +-- 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 + +import Data.Metrology.TH +import Data.Units.SI ( Gram ) + +import Language.Haskell.TH + +declareDerivedUnit "Pound" [t| Gram |] 453.59237 (Just "lb") + +declareDerivedUnit "Grain" [t| Pound |] (1/7000) (Just "gr") +declareDerivedUnit "Dram" [t| Grain |] (27 + 11/32) (Just "dr") +declareDerivedUnit "Ounce" [t| Pound |] (1/16) (Just "oz") +declareDerivedUnit "Hundredweight" [t| Pound |] 100 (Just "cwt") +declareDerivedUnit "LongHundredweight" [t| Pound |] 112 (Just "longcwt") +declareDerivedUnit "Ton" [t| Pound |] 2000 (Just "ton") +declareDerivedUnit "LongTon" [t| Pound |] 2240 (Just "longton") + +-- | Includes 'Ounce', 'Pound', 'Ton' +commonMassMeasures :: [Name] +commonMassMeasures = [ ''Ounce, ''Pound, ''Ton] + +-- | Includes 'Grain', 'Dram', 'Hundredweight', 'LongHundredweight', +-- and 'LongTon' +otherMassMeasures :: [Name] +otherMassMeasures = [ ''Grain, ''Dram, ''Hundredweight, ''LongHundredweight + , ''LongTon ] diff --git a/units-defs/Data/Units/US/DryVolume.hs b/units-defs/Data/Units/US/DryVolume.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/US/DryVolume.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.US.DryVolume +-- 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 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 + +import Data.Metrology +import Data.Metrology.TH +import Data.Units.US.Misc + +import Language.Haskell.TH + +declareDerivedUnit "Gallon" [t| Inch :^ Three |] 268.8025 (Just "gal") +declareDerivedUnit "Quart" [t| Gallon |] (1/4) (Just "qt") +declareDerivedUnit "Pint" [t| Quart |] (1/2) (Just "pt") +declareDerivedUnit "Peck" [t| Gallon |] 2 (Just "pk") +declareDerivedUnit "Bushel" [t| Peck |] 4 (Just "bu") +declareDerivedUnit "Barrel" [t| Inch :^ Three |] 7056 (Just "bbl") +declareDerivedUnit "Cord" [t| Foot :^ Three |] 128 (Just "cd") +declareDerivedUnit "BoardFoot" [t| Foot :^ Three |] (1/12) (Just "FBM") +declareDerivedUnit "RegisterTon" [t| Foot :^ Three |] 100 (Just "RT") + +declareDerivedUnit "CranberryBarrel" [t| Inch :^ Three |] 5826 (Just "bbl") + +-- | Includes all measures in this file, except 'CranberryBarrel'. +dryVolumeMeasures :: [Name] +dryVolumeMeasures = [ ''Pint, ''Quart, ''Gallon, ''Peck, ''Bushel + , ''Barrel, ''Cord, ''BoardFoot, ''RegisterTon ] diff --git a/units-defs/Data/Units/US/Liquid.hs b/units-defs/Data/Units/US/Liquid.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/US/Liquid.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.US.Liquid +-- 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 liquid volume measures as used in the USA. +-- Note that liquid volumes in the USA differ both from solid volumes +-- 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 + +import Data.Metrology +import Data.Metrology.TH +import Data.Units.US.Misc + +import Language.Haskell.TH + +declareDerivedUnit "Gallon" [t| Inch :^ Three |] 231 (Just "gal") + +declareDerivedUnit "FluidOunce" [t| Gallon |] (1/128) (Just "floz") +declareDerivedUnit "Gill" [t| FluidOunce |] 4 (Just "gi") +declareDerivedUnit "Cup" [t| FluidOunce |] 8 (Just "cp") +declareDerivedUnit "Pint" [t| FluidOunce |] 16 (Just "pt") +declareDerivedUnit "Quart" [t| Gallon |] (1/4) (Just "qt") + +declareDerivedUnit "Teaspoon" [t| FluidOunce |] (1/6) (Just "tsp") +declareDerivedUnit "Tablespoon" [t| Teaspoon |] 3 (Just "Tbsp") +declareDerivedUnit "Shot" [t| Tablespoon |] 3 (Just "jig") +declareDerivedUnit "Minim" [t| Teaspoon |] (1/80) (Just "min") +declareDerivedUnit "Dram" [t| Minim |] 60 (Just "fldr") + +declareDerivedUnit "Hogshead" [t| Gallon |] 63 (Just "hogshead") +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 +commonLiquidMeasures :: [Name] +commonLiquidMeasures = [ ''Teaspoon, ''Tablespoon, ''FluidOunce, ''Cup, ''Pint + , ''Quart, ''Gallon ] + +-- | Includes the rest of the measures in this file. +otherLiquidMeasures :: [Name] +otherLiquidMeasures = [ ''Minim, ''Dram, ''Shot, ''Gill, ''Barrel + , ''OilBarrel, ''Hogshead ] diff --git a/units-defs/Data/Units/US/Misc.hs b/units-defs/Data/Units/US/Misc.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/US/Misc.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.US.Misc +-- 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 American customary units that don't fit into +-- 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 ( + module Data.Units.US.Misc, + Maxwell(..) + ) where + +import Data.Metrology +import Data.Metrology.TH + +import Data.Units.SI +import Data.Units.SI.Prefixes +import Data.Units.CGS +import Data.Constants.Math + +import Language.Haskell.TH + +declareDerivedUnit "Foot" [t| Meter |] 0.3048 (Just "ft") +declareDerivedUnit "Inch" [t| Foot |] (1/12) (Just "in") +declareDerivedUnit "Yard" [t| Foot |] 3 (Just "yd") +declareDerivedUnit "Mile" [t| Foot |] 5280 (Just "mi") +declareDerivedUnit "Angstrom" [t| Nano :@ Meter |] 0.1 (Just "Å") +declareDerivedUnit "Hand" [t| Inch |] 4 (Just "hand") +declareDerivedUnit "Mil" [t| Inch |] 0.001 (Just "mil") + +declareDerivedUnit "Point" [t| Inch |] 0.013837 (Just "p") +declareDerivedUnit "Pica" [t| Point |] 12 (Just "P") + +declareDerivedUnit "Fathom" [t| Yard |] 2 (Just "ftm") +declareDerivedUnit "Cable" [t| Fathom |] 120 (Just "cb") +declareDerivedUnit "NauticalMile" [t| Kilo :@ Meter |] 1.852 (Just "NM") + +declareDerivedUnit "Knot" [t| NauticalMile :/ Hour |] 1 (Just "kn") + +declareDerivedUnit "Atmosphere" [t| Kilo :@ Pascal |] 101.325 (Just "atm") +declareDerivedUnit "Bar" [t| Kilo :@ Pascal |] 100 (Just "bar") +declareDerivedUnit "MillimeterOfMercury" + [t| Pascal |] 133.322387415 (Just "mmHg") +declareDerivedUnit "Torr" [t| Atmosphere |] (1/760) (Just "Torr") + + +declareDerivedUnit "Calorie" [t| Joule |] 4.184 (Just "cal") +declareDerivedUnit "FoodCalorie" [t| Kilo :@ Calorie |] 1 (Just "Cal") +declareDerivedUnit "Therm" [t| Mega :@ Joule |] 105.4804 (Just "thm") +declareDerivedUnit "Btu" [t| Joule |] 1055.05585262 (Just "btu") + +declareDerivedUnit "Horsepower" [t| Watt |] 746 (Just "hp") + +declareDerivedUnit "Rankine" [t| Kelvin |] (5/9) (Just "°R") + +declareDerivedUnit "PoundForce" [t| Newton |] 4.4482216152605 (Just "lbf") + +declareDerivedUnit "Slug" [t| PoundForce :* (Second :^ Two) :/ Foot |] + 1 (Just "slug") + +declareDerivedUnit "Oersted" [t| Ampere :/ Meter |] + (1000 / (4 * piR)) (Just "Oe") + +-- | Standard lengths: 'Foot', 'Inch', 'Yard', and 'Mile' +lengths :: [Name] +lengths = [ ''Foot, ''Inch, ''Yard, ''Mile ] + + diff --git a/units-defs/Data/Units/US/Survey.hs b/units-defs/Data/Units/US/Survey.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/US/Survey.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.US.Survey +-- 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 survey measures as used in the USA. +-- Note that a survey foot is ever so slightly different from a standard +-- 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 + +import Data.Metrology +import Data.Metrology.TH +import Data.Units.SI + +import Language.Haskell.TH + +declareDerivedUnit "Foot" [t| Meter |] (1200/3937) (Just "ft") +declareDerivedUnit "Link" [t| Foot |] 0.66 (Just "li") +declareDerivedUnit "Rod" [t| Link |] 25 (Just "rd") +declareDerivedUnit "Chain" [t| Rod |] 4 (Just "ch") +declareDerivedUnit "Furlong" [t| Chain |] 10 (Just "fur") +declareDerivedUnit "Mile" [t| Furlong |] 8 (Just "mi") +declareDerivedUnit "League" [t| Mile |] 3 (Just "lea") + +-- | Includes all the lengths above. +surveyLengths :: [Name] +surveyLengths = [ ''Foot, ''Link, ''Rod, ''Chain, ''Furlong + , ''Mile, ''League ] + +declareDerivedUnit "Acre" [t| Foot :^ Two |] 43560 (Just "acre") +declareDerivedUnit "Section" [t| Acre |] 640 (Just "section") +declareDerivedUnit "Township" [t| Section |] 36 (Just "twp") + +-- | Includes all the areas above. +surveyAreas :: [Name] +surveyAreas = [ ''Acre, ''Section, ''Township ] diff --git a/units-defs/Data/Units/US/Troy.hs b/units-defs/Data/Units/US/Troy.hs new file mode 100644 --- /dev/null +++ b/units-defs/Data/Units/US/Troy.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE TemplateHaskell, TypeFamilies, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Units.US.Troy +-- 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 troy measures of mass. The troy +-- 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 ( + module Data.Units.US.Troy, + + -- | The avoirdupois grain is the same as the troy grain + Grain(..) + ) where + +import Data.Metrology.TH +import Data.Units.US.Avoirdupois ( Grain(..) ) + +import Language.Haskell.TH + +declareDerivedUnit "Pennyweight" [t| Grain |] 24 (Just "dwt") +declareDerivedUnit "Ounce" [t| Pennyweight |] 20 (Just "ozt") +declareDerivedUnit "Pound" [t| Ounce |] 12 (Just "lbt") + +-- | Includes 'Grain', 'Pennyweight', 'Ounce', and 'Pound' +troyMassMeasures :: [Name] +troyMassMeasures = [ ''Grain, ''Pennyweight, ''Ounce, ''Pound ] diff --git a/units.cabal b/units.cabal --- a/units.cabal +++ b/units.cabal @@ -1,5 +1,5 @@ name: units -version: 2.2.1 +version: 2.3 cabal-version: >= 1.10 synopsis: A domain-specific type system for dimensional analysis homepage: https://github.com/goldfirere/units @@ -14,9 +14,13 @@ , Tests/README.md , Tests/Compile/*.hs , Tests/Compile/UnitParser/*.hs + , units-defs/Data/Constants/*.hs + , units-defs/Data/Dimensions/*.hs , units-defs/Data/Metrology/*.hs , units-defs/Data/Metrology/SI/*.hs - , units-defs/Data/Metrology/Imperial/*.hs + , units-defs/Data/Units/*.hs + , units-defs/Data/Units/SI/*.hs + , units-defs/Data/Units/US/*.hs license: BSD3 license-file: LICENSE build-type: Simple @@ -42,7 +46,7 @@ source-repository this type: git location: https://github.com/goldfirere/units.git - tag: v2.2.1 + tag: v2.3 library ghc-options: -Wall @@ -51,7 +55,7 @@ ghc-options: -fno-warn-unticked-promoted-constructors build-depends: base >= 4.7 && < 5 - , th-desugar >= 1.4.2 + , th-desugar >= 1.5.4 , singletons >= 0.9 && < 2 , vector-space >= 0.8 , template-haskell @@ -59,9 +63,9 @@ , multimap >= 1.2 , syb >= 0.3 , containers >= 0.4 - , parsec >= 3 - exposed-modules: - Data.Metrology, + , units-parser >= 0.1 && < 1.0 + exposed-modules: + Data.Metrology, Data.Metrology.Internal, Data.Metrology.Show, Data.Metrology.Unsafe, @@ -73,15 +77,14 @@ Data.Metrology.TH, Data.Metrology.Quantity - other-modules: + other-modules: Data.Metrology.Factor, Data.Metrology.LCSU, Data.Metrology.Qu, Data.Metrology.Dimensions, Data.Metrology.Units, Data.Metrology.Combinators, - Data.Metrology.Validity, - Data.Metrology.Parser.Internal + Data.Metrology.Validity -- cabal now recommends that TH be explicitly listed in cabal files other-extensions: TemplateHaskell @@ -93,7 +96,7 @@ default-language: Haskell2010 build-depends: units , base >= 4.7 && < 5 - , th-desugar >= 1.4.2 + , th-desugar >= 1.5.4 , singletons >= 0.9 && < 2 , vector-space >= 0.8 , tasty >= 0.8 @@ -104,7 +107,7 @@ , multimap >= 1.2 , syb >= 0.3 , containers >= 0.4 - , parsec >= 3 + , units-parser >= 0.1 && < 1.0 hs-source-dirs: units-defs, . -- optimize compile time, not runtime!