packages feed

quantities (empty) → 0.1.0

raw patch · 14 files changed

+1177/−0 lines, 14 filesdep +basedep +containersdep +hlintsetup-changed

Dependencies added: base, containers, hlint, hspec, mtl, parsec, quantities

Files

+ CHANGES.md view
@@ -0,0 +1,12 @@+quantities changelog+====================++0.1 (unreleased)+----------------++- Full implementation of multiplicative dimensional quantities (no offsets yet+  for temperatures).+- Support for conversions and monadic quantity computations.+- Builtin expression parser.+- Simple definitions file format, fully stocked with units.+- Travis CI, HSpec units tests, and HLint check.
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2014, John David Reaver+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ library/Data/Quantities.hs view
@@ -0,0 +1,92 @@+-- | This package is used to create and manipulate physical quantities, which+-- are a numerical value associated with a unit of measurement.+--+-- In this package, values with units are represented with the Quantity type.+-- Included is an expression parser and a huge list of predefined quantities+-- with which to parse strings into a Quantity datatype. Once created, a+-- quantity can be converted to different units or queried for its+-- dimensionality. A user can also operate on quantities arithmetically, and+-- doing so uses automatic unit conversion and simplifcation.+++module Data.Quantities+       (+         -- * Constructors+         -- $constructors+         fromString+       , unitsFromString+       , Quantity+       , magnitude+       , units+       , CompositeUnit+       , SimpleUnit+         -- * Conversion+         -- $conversion+       , convert+       , convertBase+       , dimensionality+         -- * Quantity arithmetic+         -- $arithmetic+       , addQuants+       , subtractQuants+       , multiplyQuants+       , divideQuants+       , exptQuants+         -- * Error type+       , QuantityError(..)+       , QuantityComputation+       , comp+       ) where+++import Data.Quantities.Constructors (fromString, unitsFromString)+import Data.Quantities.Convert (convert, convertBase, addQuants, subtractQuants,+                                dimensionality)+import Data.Quantities.Data++-- $constructors+--+-- Currently, one constructor is supported to create quantities: 'fromString'.+-- There is an included expression parser that can parse values and strings+-- corresponding to builtin units. To view defined unit types, look at the+-- /source code/ for 'Data.Quantities.DefaultUnits.defaultDefString'.++-- $conversion+--+-- These functions are used to convert quantities from one unit type to+-- another.+++-- $arithmetic+--+-- Once created, quantities can be manipulated using the included arithmetic+-- functions.+--+-- >>> let (Right x) = fromString "m/s"+-- >>> let (Right y) = fromString "mile/hr"+-- >>> x `multiplyQuants` y+-- 1.0 meter mile / hour / second+-- >>> x `divideQuants` y+-- 1.0 hour meter / mile / second+-- >>> x `addQuants` y+-- Right 1.4470399999999999 meter / second+-- >>> x `subtractQuants` y+-- Right 0.55296 meter / second+-- >>> x `exptQuants` 1.5+-- 1.0 meter ** 1.5 / second ** 1.5+--+-- The functions 'multiplyQuants', 'divideQuants', and 'exptQuants' change+-- units, and the units of the result are reduced to simplest terms.+--+-- >>> x `divideQuants` x+-- 1.0+-- >>> fmap (multiplyQuants x) $ fromString "s"+-- Right 1.0 meter+-- >>> x `exptQuants` 0+-- 1.0++comp :: QuantityComputation Quantity+comp = do+  x <- fromString "BADUNIT"+  y <- unitsFromString "m/s"+  convert x y
+ library/Data/Quantities/Constructors.hs view
@@ -0,0 +1,39 @@+module Data.Quantities.Constructors where++import Data.Quantities.Data (Definitions, CompositeUnit, Quantity(units),+                             QuantityError(..))+import Data.Quantities.DefaultUnits (defaultDefString)+import Data.Quantities.DefinitionParser (readDefinitions)+import Data.Quantities.Definitions (makeDefinitions, preprocessQuantity)+import Data.Quantities.ExprParser (parseExprQuant)++defaultDefinitions :: Either QuantityError Definitions+defaultDefinitions = makeDefinitions $ readDefinitions defaultDefString++d :: Definitions+(Right d) = defaultDefinitions++-- | Create a Quantity by parsing a string. Uses an+-- 'UndefinedUnitError' for undefined units.+--+-- >>> fromString "25 m/s"+-- Right 25.0 meter / second+-- >>> fromString "fakeunit"+-- Left (UndefinedUnitError "fakeunit")++fromString :: String -> Either QuantityError Quantity+fromString s =+  case rawq of+    (Left err) -> Left $ ParserError err+    (Right q)  -> case preprocessQuantity d q of+      (Left err) -> Left err+      (Right q') -> Right q'+  where rawq = parseExprQuant s+++-- | Parse units from a string. Equivalent to @fmap units . fromString@+--+-- >>> unitsFromString "N * s"+-- Right [newton,second]+unitsFromString :: String -> Either QuantityError CompositeUnit+unitsFromString = fmap units . fromString
+ library/Data/Quantities/Convert.hs view
@@ -0,0 +1,88 @@+module Data.Quantities.Convert where++import Data.List (sort)+import qualified Data.Map as M++import Data.Quantities.Data (Quantity(..), CompositeUnit, SimpleUnit(..), Definitions(..)+                            ,multiplyQuants, QuantityError(..))++unityQuant :: Definitions -> Quantity+unityQuant = Quantity 1 []++-- | Convert quantity to given units.+--+-- >>> convert <$> fromString "m" <*> unitsFromString "ft"+-- Right (Right 3.280839895013123 foot)+convert :: Quantity -> CompositeUnit -> Either QuantityError Quantity+convert x = convert' (defs x) x+++-- | Convert a quantity to its base units.+--+-- >>> convertBase <$> fromString "newton"+-- Right 1000.0 gram meter / second ** 2.0+convertBase :: Quantity -> Quantity+convertBase x = convertBase' (defs x) x+++-- | Convert quantity to given units.+convert' :: Definitions -> Quantity -> CompositeUnit -> Either QuantityError Quantity+convert' d q us'+  | dimq /= dimus = Left $ DimensionalityError dimq dimus+  | otherwise     = Right $ Quantity (mb/mb') us' d+  where (Quantity mb  _ _) = convertBase' d q+        (Quantity mb' _ _) = toBase d us'+        dimq               = dimensionality' d (units q)+        dimus              = dimensionality' d us'+++-- | Convert a quantity to its base units.+convertBase' :: Definitions -> Quantity -> Quantity+convertBase' d (Quantity m us _) = Quantity (m*mb) ub d+  where (Quantity mb ub _) = toBase d us+++-- | Converts a composite unit to its base quantity+toBase :: Definitions -> CompositeUnit -> Quantity+toBase d = foldr (multiplyQuants . simpleToBase d) (unityQuant d)+++-- | Converts a simple unit to its base quantity.+simpleToBase :: Definitions -> SimpleUnit -> Quantity+simpleToBase d (SimpleUnit sym pre pow) = Quantity m us d+  where (m', u') = bases d M.! sym+        us = map (\(SimpleUnit s p pow') -> SimpleUnit s p (pow*pow')) u'+        m = (m' * (prefixValues d M.! pre)) ** pow+++-- | Computes dimensionality of quantity.+--+-- >>> dimensionality <$> fromString "newton"+-- Right [length,mass,time ** -2.0]+dimensionality :: Quantity -> CompositeUnit+dimensionality q = dimensionality' (defs q) (units q)++dimensionality' :: Definitions -> CompositeUnit -> CompositeUnit+dimensionality' d us = sort $ map dim ub+  where (Quantity _ ub _) = toBase d us+        dim (SimpleUnit sym _ pow) = SimpleUnit (unitTypes d M.! sym) "" pow+++-- | Adds two quantities. Second quantity is converted to units of+-- first quantity.+addQuants :: Quantity -> Quantity -> Either QuantityError Quantity+addQuants = linearQuants (+)+++-- | Subtract two quantities. Second quantity is converted to units of+-- first quantity.+subtractQuants :: Quantity -> Quantity -> Either QuantityError Quantity+subtractQuants = linearQuants (-)+++linearQuants :: (Double -> Double -> Double) -> Quantity -> Quantity+                -> Either QuantityError Quantity+linearQuants f (Quantity m1 u1 d) q2 = case q of+  (Right q') -> Right $ Quantity (f m1 (magnitude q')) u1 d+  (Left err) -> Left err+  where q = convert q2 u1
+ library/Data/Quantities/Data.hs view
@@ -0,0 +1,192 @@+-- | Base module for all data structures.+module Data.Quantities.Data where++import Data.List (partition, sort)+import qualified Data.Map as M++-- | String representation of a unit. Examples: "meter", "foot"+type Symbol = String++-- | Representation of single unit. For example: \"mm^2\" is+-- represented as+--+-- > SimpleUnit { symbol = "meter", prefix = "milli", power = 2.0 }+data SimpleUnit = SimpleUnit { symbol :: String+                             , prefix :: String+                             , power  :: Double} deriving (Eq, Ord)++instance Show SimpleUnit where+  show (SimpleUnit s pr p)+    | p == 1    = sym+    | otherwise = sym ++ " ** " ++ show p+    where sym = pr ++ s+++-- | Collection of SimpleUnits. Represents combination of simple+-- units.+type CompositeUnit = [SimpleUnit]++-- | Used to show composite units.+showCompUnit :: CompositeUnit -> String+showCompUnit = unwords . map showCompUnit' . showSort++-- | Show a single unit, but prepend with '/' if negative+showCompUnit' :: SimpleUnit -> String+showCompUnit' (SimpleUnit s pr p)+  | p == 1    = sym+  | p == -1   = "/ " ++ sym+  | p < 0     = "/ " ++ sym ++ " ** " ++ show (-p)+  | otherwise = sym ++ " ** " ++ show p+  where sym = pr ++ s+++-- | Combination of magnitude and units.+data Quantity = Quantity { magnitude :: Double+                           -- ^ Numerical magnitude of quantity.+                           --+                           -- >>> magnitude <$> fromString "100 N * m"+                           -- Right 100.0+                         , units     :: CompositeUnit+                           -- ^ Units associated with quantity.+                           --+                           -- >>> units <$> fromString "3.4 m/s^2"+                           -- Right [meter,second ** -2.0]+                         , defs      :: Definitions } deriving (Ord)+++instance Show Quantity where+  show (Quantity m us _) = show m ++ " " ++ showCompUnit us++-- | Sort units but put negative units at end.+showSort :: CompositeUnit -> CompositeUnit+showSort c = pos ++ neg+  where (pos, neg) = partition (\q -> power q > 0) c++instance Eq Quantity where+  (Quantity m1 u1 _) == (Quantity m2 u2 _) = m1 == m2 && sort u1 == sort u2+++-- | Quantity without definitions.+baseQuant :: Double -> CompositeUnit -> Quantity+baseQuant m u = Quantity m u emptyDefinitions++fromDefinitions :: Definitions -> Double -> CompositeUnit -> Quantity+fromDefinitions d m u = Quantity m u d++-- | Custom error type+data QuantityError = UndefinedUnitError String+                     -- ^ Used when trying to parse an undefined unit.+                   | DimensionalityError CompositeUnit CompositeUnit+                     -- ^ Used when converting units that do not have the same+                     -- dimensionality (example: convert meter to second).+                   | UnitAlreadyDefinedError String+                     -- ^ Used internally when defining units and a unit is+                     -- already defined.+                   | PrefixAlreadyDefinedError String+                     -- ^ Used internally when defining units and a prefix is+                     -- already defined.+                   | ParserError String+                     -- ^ Used when a string cannot be parsed.+                   deriving (Show, Eq)+++-- | Computation monad that propagates 'QuantityError's. Some examples:+--+-- > computation :: QuantityComputation Quantity+-- > computation = do+-- >   x <- fromString "mile/hr"+-- >   y <- unitsFromString "m/s"+-- >   convert x y+--+-- Returns @Right 0.44704 meter / second@+--+-- > computation :: QuantityComputation Quantity+-- > computation = do+-- >   x <- fromString "BADUNIT"+-- >   convertBase x+--+-- Returns @Left (UndefinedUnitError "BADUNIT")@++type QuantityComputation = Either QuantityError++-- | Combines equivalent units and removes units with powers of zero.+reduceUnits :: Quantity -> Quantity+reduceUnits q = q { units = reduceUnits' (units q) }++reduceUnits', removeZeros :: CompositeUnit -> CompositeUnit+reduceUnits'  = removeZeros . reduceComp . sort+  where reduceComp [] = []+        reduceComp (SimpleUnit x pr1 p1 : SimpleUnit y pr2 p2: xs)+          | (x,pr1) == (y,pr2) = SimpleUnit x pr1 (p1+p2) : reduceComp xs+          | otherwise = SimpleUnit x pr1 p1 : reduceComp (SimpleUnit y pr2 p2 : xs)+        reduceComp (x:xs) = x : reduceComp xs+++removeZeros [] = []+removeZeros (SimpleUnit _ _ 0.0 : xs) = removeZeros xs+removeZeros (x:xs) = x : removeZeros xs++invertUnits :: CompositeUnit -> CompositeUnit+invertUnits = map invertSimpleUnit++-- | Inverts unit by negating the power field.+invertSimpleUnit :: SimpleUnit -> SimpleUnit+invertSimpleUnit (SimpleUnit s pr p) = SimpleUnit s pr (-p)++-- | Multiplies two quantities.+multiplyQuants :: Quantity -> Quantity -> Quantity+multiplyQuants x y = reduceUnits $ Quantity mag newUnits (defs x)+  where mag      = magnitude x * magnitude y+        newUnits = units x ++ units y++-- | Divides two quantities.+divideQuants :: Quantity -> Quantity -> Quantity+divideQuants x y = reduceUnits $ Quantity mag newUnits (defs x)+  where mag      = magnitude x / magnitude y+        newUnits = units x ++ invertUnits (units y)++-- | Exponentiates a quantity with a double.+exptQuants :: Quantity -> Double -> Quantity+exptQuants (Quantity x u d) y = reduceUnits $ Quantity (x**y) (expUnits u) d+  where expUnits = map (\(SimpleUnit s pr p) -> SimpleUnit s pr (p*y))+++data Definition = PrefixDefinition { defPrefix   :: Symbol+                                   , factor      :: Double+                                   , defSynonyms :: [Symbol]}+                | BaseDefinition   { base        :: Symbol+                                   , dimBase     :: Symbol+                                   , defSynonyms ::[Symbol]}+                | UnitDefinition   { defSymbol   :: Symbol+                                   , quantity    :: Quantity+                                   , defSynonyms :: [Symbol]} deriving (Show, Eq, Ord)+++data Definitions = Definitions { bases          :: M.Map String (Double, CompositeUnit)+                               , synonyms       :: M.Map String String+                               , unitsList      :: [String]+                               , prefixes       :: [String]+                               , prefixValues   :: M.Map String Double+                               , prefixSynonyms :: M.Map String String+                               , unitTypes      :: M.Map String String } deriving (Show, Eq, Ord)++emptyDefinitions :: Definitions+emptyDefinitions = Definitions { bases          = M.empty+                               , synonyms       = M.empty+                               , unitsList      = []+                               , prefixes       = []+                               , prefixValues   = M.fromList [("", 1)]+                               , prefixSynonyms = M.fromList [("", "")]+                               , unitTypes      = M.empty }+++-- | Combine two Definitions structures+unionDefinitions :: Definitions -> Definitions -> Definitions+unionDefinitions d1 d2 = Definitions {+  bases = bases d1 `M.union` bases d2+  , synonyms = synonyms d1 `M.union` synonyms d2+  , unitsList = unitsList d1 ++ unitsList d2+  , prefixes = prefixes d1 ++ prefixes d2+  , prefixValues = prefixValues d1 `M.union` prefixValues d2+  , prefixSynonyms = prefixSynonyms d1 `M.union` prefixSynonyms d2+  , unitTypes = unitTypes d1 `M.union` unitTypes d2 }
+ library/Data/Quantities/DefaultUnits.hs view
@@ -0,0 +1,336 @@+module Data.Quantities.DefaultUnits (defaultDefString) where++-- | View the source code for this declaration to see what units and prefixes+-- are defined.+--+-- This string holds the definitions for units and prefixes. Base units are+-- defined by the name of the unit, the name of the base in brackets, and any+-- aliases for the unit after that, all separated by equal signs: @meter =+-- [length] = m@. Prefixes are defined by placing a dash after all identifiers,+-- and providing a value for the prefix: @milli- = 1e-3 = m-@. Other units are+-- defined by using /previously defined units/ in an expression: @minute = 60 *+-- second = min@.+--+-- The reason these definitions aren't placed in a text file is so you don't+-- have to operate your whole program in the IO monad. Theoretically, a user of+-- this package can create their own definitions file or modify this one, but a+-- mechanism for doing so hasn't been created yet.+--+-- These definitions are taken almost verbatim from the Pint unit conversion+-- library for the Python programming language. Check them out on+-- <https://github.com/hgrecco/pint GitHub>.+defaultDefString :: String+defaultDefString = unlines [++  -- decimal prefixes+  "yocto- = 1e-24 = y-"+  ,"zepto- = 1e-21 = z-"+  ,"atto- =  1e-18 = a-"+  ,"femto- = 1e-15 = f-"+  ,"pico- =  1e-12 = p-"+  ,"nano- =  1e-9  = n-"+  ,"micro- = 1e-6  = u-"+  ,"milli- = 1e-3  = m-"+  ,"centi- = 1e-2  = c-"+  ,"deci- =  1e-1  = d-"+  ,"deca- =  1e+1  = da-"+  ,"hecto- = 1e2   = h-"+  ,"kilo- =  1e3   = k-"+  ,"mega- =  1e6   = M-"+  ,"giga- =  1e9   = G-"+  ,"tera- =  1e12  = T-"+  ,"peta- =  1e15  = P-"+  ,"exa- =   1e18  = E-"+  ,"zetta- = 1e21  = Z-"+  ,"yotta- = 1e24  = Y-"++   -- binary_prefixes+  ,"kibi- = 2**10 = Ki-"+  ,"mebi- = 2**20 = Mi-"+  ,"gibi- = 2**30 = Gi-"+  ,"tebi- = 2**40 = Ti-"+  ,"pebi- = 2**50 = Pi-"+  ,"exbi- = 2**60 = Ei-"+  ,"zebi- = 2**70 = Zi-"+  ,"yobi- = 2**80 = Yi-"++   -- reference+  ,"meter = [length] = m = metre"+  ,"second = [time] = s = sec"+  ,"ampere = [current] = A = amp"+  ,"candela = [luminosity] = cd = candle"+  ,"gram = [mass] = g"+  ,"mole = [substance] = mol"+  --,"degK = [temperature]; offset: 0 = K = kelvin"+  ,"radian = [] = rad"+  ,"bit = []"+  ,"count = []"++  ,"pi = 3.14159265359"+  ,"gstandard_gravity = 9.806650 * meter / second ** 2 = g_0 = g_n = gravity"+  ,"speed_of_light = 299792458 * meter / second = c"++   -- acceleration+   -- [acceleration] = [length] / [time] ** 2++   -- Angle+  ,"turn = 2 * pi * radian = revolution = cycle = circle"+  ,"degree = pi / 180 * radian = deg = arcdeg = arcdegree = angular_degree"+  ,"arcminute = arcdeg / 60 = arcmin = arc_minute = angular_minute"+  ,"arcsecond = arcmin / 60 =  arcsec = arc_second = angular_second"+  ,"steradian = radian ** 2 = sr"++    -- Time+  ,"minute = 60 * second = min"+  ,"hour = 60 * minute = h = hr"+  ,"day = 24 * hour"+  ,"week = 7 * day"+  ,"fortnight = 2 * week"+  ,"year = 31556925.9747 * second"+  ,"month = year/12"+  ,"shake = 1e-8 * second"+  ,"sidereal_day = day / 1.00273790935079524"+  ,"sidereal_hour = sidereal_day/24"+  ,"sidereal_minute = sidereal_hour/60"+  ,"sidereal_second =sidereal_minute/60"+  ,"sidereal_year = 366.25636042 * sidereal_day"+  ,"sidereal_month = 27.321661 * sidereal_day"+  ,"tropical_month = 27.321661 * day"+  ,"synodic_month = 29.530589 * day = lunar_month"+  ,"common_year = 365 * day"+  ,"leap_year = 366 * day"+  ,"julian_year = 365.25 * day"+  ,"gregorian_year = 365.2425 * day"+  ,"millenium = 1000 * year = millenia = milenia = milenium"+  ,"eon = 1e9 * year"+  ,"work_year = 2056 * hour"+  ,"work_month = work_year/12"++   -- Length+  ,"angstrom = 1e-10 * meter"+  ,"inch = 2.54 * centimeter = international_inch = inches = international_inches = in"+  ,"foot = 12 * inch = international_foot = ft = feet = international_foot = international_feet"+  ,"mile = 5280 * foot = mi = international_mile"+  ,"yard = 3 * feet = yd = international_yard"+  ,"mil = inch / 1000 = thou"+  ,"parsec = 3.08568025e16 * meter = pc"+  ,"light_year = speed_of_light * julian_year = ly = lightyear"+  ,"astronomical_unit = 149597870691 * meter = au"+  ,"nautical_mile = 1.852e3 * meter = nmi"+  ,"printers_point = 127 * millimeter / 360 = point"+  ,"printers_pica = 12 * printers_point = pica"+  ,"US_survey_foot = 1200 * meter / 3937"+  ,"US_survey_yard =  3 * US_survey_foot"+  ,"US_survey_mile = 5280 * US_survey_foot = US_statute_mile"+  ,"rod = 16.5 * US_survey_foot = pole = perch"+  ,"furlong = 660 * US_survey_foot"+  ,"fathom = 6 * US_survey_foot"+  ,"chain = 66 * US_survey_foot"+  ,"barleycorn = inch / 3"+  ,"arpentlin = 191.835 * feet"+  ,"kayser = 1 / centimeter = wavenumber"+++   -- Mass+  ,"ounce = 28.349523125 * gram = oz = avoirdupois_ounce"+  ,"dram = oz / 16 = dr = avoirdupois_dram"+  ,"pound = 0.45359237 * kilogram = lb = avoirdupois_pound"+  ,"stone = 14 * lb = st"+  ,"carat = 200 * milligram"+  ,"grain = 64.79891 * milligram = gr"+  ,"long_hundredweight = 112 * lb"+  ,"short_hundredweight = 100 * lb"+  ,"metric_ton = 1000 * kilogram = t = tonne"+  ,"pennyweight = 24 * gram = dwt"+  ,"slug = 14.59390 * kilogram"+  ,"troy_ounce = 480 * gram = toz = apounce = apothecary_ounce"+  ,"troy_pound = 12 * toz = tlb = appound = apothecary_pound"+  ,"drachm = 60 * gram = apdram = apothecary_dram"+  ,"atomic_mass_unit = 1.660538782e-27 * kilogram =  u = amu = dalton = Da"+  ,"scruple = 20 * gram"+  ,"bag = 94 * lb"+  ,"ton = 2000 * lb = short_ton"++   -- Force+   --[force] = [mass] * [acceleration]+  ,"newton = kilogram * meter / second ** 2 = N"+  ,"dyne = gram * centimeter / second ** 2 = dyn"+  ,"force_kilogram = g_0 * kilogram = kgf = kilogram_force = pond"+  ,"force_gram = g_0 * gram = gf = gram_force"+  ,"force_ounce = g_0 * ounce = ozf = ounce_force"+  ,"force_pound = g_0 * lb = lbf = pound_force"+  ,"force_ton = 2000 * force_pound = ton_force"+  ,"poundal = lb * feet / second ** 2 = pdl"+  ,"kip = 1000*lbf"++   -- Area+   -- [area] = [length] ** 2+  ,"are = 100 * m**2"+  ,"barn = 1e-28 * m ** 2 = b"+  ,"cmil = 5.067075e-10 * m ** 2 = circular_mils"+  ,"darcy = 9.869233e-13 * m ** 2"+  ,"acre = 4046.8564224 * m ** 2 = international_acre"+  ,"US_survey_acre = 160 * rod ** 2"++   -- Energy+  ,"joule = newton * meter = J"+  ,"erg = dyne * centimeter"+  ,"btu = 1.05505585262e3 * joule = Btu = BTU = british_thermal_unit"+  ,"eV = 1.60217653e-19 * J = electron_volt"+  ,"thm = 100000 * BTU = therm = EC_therm"+  ,"cal = 4.184 * joule = calorie = thermochemical_calorie"+  ,"international_steam_table_calorie = 4.1868 * joule"+  ,"ton_TNT = 4.184e9 * joule = tTNT"+  ,"US_therm = 1.054804e8 * joule"+  ,"E_h = 4.35974394e-18 * joule = hartree = hartree_energy"+++  -- Power+  ,"watt = joule / second = W = volt_ampere = VA"+  ,"horsepower = 33000 * ft * lbf / min = hp = UK_horsepower = British_horsepower"+  ,"boiler_horsepower = 33475 * btu / hour"+  ,"metric_horsepower =  75 * force_kilogram * meter / second"+  ,"electric_horsepower = 746 * watt"+  ,"hydraulic_horsepower = 550 * feet * lbf / second"+  ,"refrigeration_ton = 12000 * btu / hour = ton_of_refrigeration"++  -- More Energy+  ,"watt_hour = watt * hour = Wh = watthour"++  -- EM+  ,"esu = 1 * erg**0.5 * centimeter**0.5 = statcoulombs = statC = franklin = Fr"+  ,"esu_per_second = 1 * esu / second = statampere"+  ,"ampere_turn = 1 * A"+  ,"gilbert = 10 / (4 * pi ) * ampere_turn = G"+  ,"coulomb = ampere * second = C"+  ,"volt = joule / coulomb = V"+  ,"farad = coulomb / volt = F"+  ,"ohm = volt / ampere"+  ,"siemens = ampere / volt = S = mho"+  ,"weber = volt * second = Wb"+  ,"tesla = weber / meter ** 2 = T"+  ,"henry = weber / ampere = H"+  ,"elementary_charge = 1.602176487e-19 * coulomb = e"+  ,"chemical_faraday = 9.64957e4 * coulomb"+  ,"physical_faraday = 9.65219e4 * coulomb"+  ,"faraday =  96485.3399 * coulomb = C12_faraday"+  ,"gamma = 1e-9 * tesla"+  ,"gauss = 1e-4 * tesla"+  ,"maxwell = 1e-8 * weber = mx"+  ,"oersted = 1000 / (4 * pi) * A / m = Oe"+  ,"statfarad = 1.112650e-12 * farad = statF = stF"+  ,"stathenry = 8.987554e11 * henry = statH = stH"+  ,"statmho = 1.112650e-12 * siemens = statS = stS"+  ,"statohm = 8.987554e11 * ohm"+  ,"statvolt = 2.997925e2 * volt = statV = stV"+  ,"unit_pole = 1.256637e-7 * weber"+++   -- Frequency+  ,"hertz = 1 / second = Hz = rps"+  ,"revolutions_per_minute = revolution / minute = rpm"+  ,"counts_per_second = count / second = cps"++   -- Information+  ,"byte = 8 * bit = Bo = octet"+  ,"baud = bit / second = Bd = bps"++   -- Textile+  ,"denier =  gram / (9000 * meter)"+  ,"tex = gram/ (1000 * meter)"+  ,"dtex = decitex"++   -- Pressure+   -- [pressure] = [force] / [area]+  ,"Hg = gravity * 13.59510 * gram / centimeter ** 3 = mercury = conventional_mercury"+  ,"mercury_60F = gravity * 13.5568 * gram / centimeter ** 3"+  ,"H2O = gravity * 1000 * kilogram / meter ** 3 = h2o = water = conventional_water"+  ,"water_4C = gravity * 999.972 * kilogram / meter ** 3 = water_39F"+  ,"water_60F = gravity * 999.001 * kilogram / m ** 3"+  ,"pascal = newton / meter ** 2 = Pa"+  ,"bar = 100000 * pascal"+  ,"atmosphere = 101325 * pascal = atm = standard_atmosphere"+  ,"technical_atmosphere = kilogram * gravity / centimeter ** 2 = at"+  ,"torr = atm / 760"+  ,"psi = pound * gravity / inch ** 2 = pound_force_per_square_inch"+  ,"ksi = kip / inch ** 2 = kip_per_square_inch"+  ,"barye = 0.1 * newton / meter ** 2 = barie = barad = barrie = baryd = Ba"+  ,"mmHg = millimeter * Hg = mm_Hg = millimeter_Hg = millimeter_Hg_0C"+  ,"cmHg = centimeter * Hg = cm_Hg = centimeter_Hg"+  ,"inHg = inch * Hg = in_Hg = inch_Hg = inch_Hg_32F"+  ,"inch_Hg_60F = inch * mercury_60F"+  ,"inch_H2O_39F = inch * water_39F"+  ,"inch_H2O_60F = inch * water_60F"+  ,"footH2O = ft * water"+  ,"cmH2O = centimeter * water"+  ,"foot_H2O = ft * water = ftH2O"+  ,"standard_liter_per_minute = 1.68875 * Pa * m ** 3 / s = slpm = slm"+++   -- Radiation+  ,"Bq = Hz = becquerel"+  ,"curie = 3.7e10 * Bq = Ci"+  ,"rutherford = 1e6*Bq = rd = Rd"+  ,"Gy = joule / kilogram = gray = Sv = sievert"+  ,"rem = 1e-2 * sievert"+  ,"rads = 1e-2 * gray"+  ,"roentgen = 2.58e-4 * coulomb / kilogram = R"++   -- Velocity+   -- [speed] = [length] / [time]+  ,"knot = nautical_mile / hour = kt = knot_international = international_knot = nautical_miles_per_hour"+  ,"mph = mile / hour = MPH"+  ,"kph = kilometer / hour = KPH"++   -- Viscosity+   -- [viscosity] = [pressure] * [time]+  ,"poise = 1e-1 * Pa * second = P"+  ,"stokes = 1e-4 * meter ** 2 / second = St"+  ,"rhe = 10 / (Pa * s)"++   -- Volume+   -- [volume] = [length] ** 3+  ,"liter = 1e-3 * m ** 3 = l = L = litre"+  ,"cc = centimeter ** 3 = cubic_centimeter"+  ,"stere = meter ** 3"+  ,"gross_register_ton = 100 * foot ** 3 = register_ton = GRT"+  ,"acre_foot = acre * foot = acre_feet"+  ,"board_foot = foot ** 2 * inch = FBM"+  ,"bushel = 2150.42 * inch ** 3 = bu = US_bushel"+  ,"dry_gallon = bushel / 8 = US_dry_gallon"+  ,"dry_quart = dry_gallon / 4 = US_dry_quart"+  ,"dry_pint = dry_quart / 2 = US_dry_pint"+  ,"gallon = 231 * inch ** 3 = liquid_gallon = US_liquid_gallon"+  ,"quart = gallon / 4 = liquid_quart = US_liquid_quart"+  ,"pint = quart / 2 = pt = liquid_pint = US_liquid_pint"+  ,"cup = pint / 2 = liquid_cup = US_liquid_cup"+  ,"gill = cup / 2 = liquid_gill = US_liquid_gill"+  ,"floz = gill / 4 = fluid_ounce = US_fluid_ounce = US_liquid_ounce"+  ,"imperial_bushel = 36.36872 * liter = UK_bushel"+  ,"imperial_gallon = imperial_bushel / 8 = UK_gallon"+  ,"imperial_quart = imperial_gallon / 4 = UK_quart"+  ,"imperial_pint = imperial_quart / 2 = UK_pint"+  ,"imperial_cup = imperial_pint / 2 = UK_cup"+  ,"imperial_gill = imperial_cup / 2 = UK_gill"+  ,"imperial_floz = imperial_gill / 5 = UK_fluid_ounce = imperial_fluid_ounce"+  ,"barrel = 42 * gallon = bbl"+  ,"tablespoon = floz / 2 = tbsp = Tbsp = Tblsp = tblsp = tbs = Tbl"+  ,"teaspoon = tablespoon / 3 = tsp"+  ,"peck = bushel / 4 = pk"+  ,"fluid_dram = floz / 8 = fldr = fluidram"+  ,"firkin = barrel / 4"+   ]++-- otherDefinitions :: String+-- otherDefinitions = unlines [+--   -- Heat+--   "RSI = degK * meter ** 2 / watt"+--   ,"clo = 0.155 * RSI = clos"+--   ,"R_value = foot ** 2 * degF * hour / btu"++--    -- Temperature+--   ,"degR = 9 / 5 * degK; offset: 0 = rankine"+--   ,"degC = degK; offset: 273.15 = celsius = C"+--   ,"degF = 9 / 5 * degK; offset: 255.372222 = fahrenheit = F"++--   ]
+ library/Data/Quantities/DefinitionParser.hs view
@@ -0,0 +1,107 @@+module Data.Quantities.DefinitionParser where++import Control.Applicative ((<$>), (<*))+import System.Environment+import Text.ParserCombinators.Parsec++import Data.Quantities.Data (Definition (..), Symbol, units, magnitude)+import Data.Quantities.ExprParser (parseExpr)+++main :: IO ()+main = do+  defs <- readDefinitions <$> head <$> getArgs+  print defs++-- | Parse multiline string of definitions (say, from a file) into a+-- list of definitions.+readDefinitions :: String -> [Definition]+readDefinitions input = case parse readDefinitions' "Input File Parser" input of+  Left err -> error (show err) >> []+  Right val -> val++readDefinitions' :: Parser [Definition]+readDefinitions' = many parseDef <* eof++-- | Parse any definition line+parseDef :: Parser Definition+parseDef  = do+  _ <- spaces+  -- skipMany comment+  optional $ many $ char '\n'+  line <- try parseDefLine <|> try parseBaseLine <|> parsePrefixLine+  spaces+  -- skipMany comment+  optional $ many $ char '\n'+  return line++-- comment :: Parser String+-- comment = char '#' >> many (noneOf "\n")++eol :: Parser Char+eol = char '\n'++-- | Parse a line containing unit definition+-- Ex: minute = 60 s = min+parseDefLine :: Parser Definition+parseDefLine = do+  (UnitDefinition s e []) <- parseUnitDef+  syns <- many (try parseSynonym)+  return $ UnitDefinition s e syns++parseUnitDef :: Parser Definition+parseUnitDef = do+  sym   <- parseSymbol <* spaces <* char '='+  quant <- parseExpr+  spaces+  -- skipMany comment+  return $ UnitDefinition sym quant []++parseSynonym :: Parser Symbol+parseSynonym = spaces >> char '=' >> spaces >> parseSymbol <* spaces+++-- | Parse line containing base definition+-- Ex: meter = [length] = m+parseBaseLine :: Parser Definition+parseBaseLine = do+  (sym, f) <- parseBase+  syns <- many (try parseSynonym)+  return $ BaseDefinition sym f syns++parseBase :: Parser (Symbol, Symbol)+parseBase = do+  sym <- parseSymbol <* spaces <* char '='+  b <- spaces >> char '[' >> option "" parseSymbol <* char ']'+  spaces+  -- skipMany comment+  return (sym, b)++-- | Parse line containing prefix definition+-- Ex: milli- = 1e-3 = m-+parsePrefixLine :: Parser Definition+parsePrefixLine = do+  (p, f) <- parsePrefix+  syns <- many (try parsePrefixSynonym)+  return $ PrefixDefinition p f syns++parsePrefix :: Parser (Symbol, Double)+parsePrefix = do+  pre <- many1 letter <* char '-' <* spaces <* char '='+  facQuant <- spaces >> parseExpr+  spaces+  if null (units facQuant) then+    return (pre, magnitude facQuant)+    else fail "No units allowed in prefix definitions"+++parsePrefixSynonym :: Parser Symbol+parsePrefixSynonym = spaces >> char '=' >> spaces >> parseSymbol <* char '-' <* spaces+++-- | Parse a symbol for a unit+parseSymbol :: Parser Symbol+parseSymbol = do+  letter' <- letter+  rest    <- many (alphaNum <|> char '_')+  return $ letter' : rest
+ library/Data/Quantities/Definitions.hs view
@@ -0,0 +1,92 @@+module Data.Quantities.Definitions where++import Control.Monad.State+import Data.Either (partitionEithers)+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Text.ParserCombinators.Parsec as P++import Data.Quantities.Convert (convertBase')+import Data.Quantities.Data++type DefineMonad = StateT Definitions (Either QuantityError)+makeDefinitions :: [Definition] -> Either QuantityError Definitions+makeDefinitions ds = execStateT (mapM addDefinition ds) emptyDefinitions++addDefinition :: Definition -> DefineMonad ()++addDefinition (PrefixDefinition sym fac syns) = do+  d <- get+  let newd = emptyDefinitions {+        prefixes         = sym : syns+        , prefixValues   = M.singleton sym fac+        , prefixSynonyms = M.fromList $ zip (sym : syns) (repeat sym) }+      defCheck = checkDefined (sym : syns) (prefixes d)+  if null defCheck+    then put $ d `unionDefinitions` newd+    else lift . Left . PrefixAlreadyDefinedError $ head defCheck ++ "-"++addDefinition (BaseDefinition sym utype syns) = do+  d <- get+  let defCheck = checkDefined (sym : syns) (unitsList d)+  if null defCheck+    then put $ d `unionDefinitions` emptyDefinitions {+      bases         = M.singleton sym (1, [SimpleUnit sym "" 1])+      , unitsList   = sym : syns+      , synonyms    = M.fromList $ zip (sym : syns) (repeat sym)+      , unitTypes   = M.singleton sym utype }+    else lift . Left $ UnitAlreadyDefinedError (head defCheck)++addDefinition (UnitDefinition sym q syns) = do+  -- First, we preprocess the quantity so all units are base units and+  -- prefixes are preprocessed. Then we do the standard Definitions+  -- modification like prefix and base definitions.+  d <- get+  let pq = preprocessQuantity d q+      defCheck = checkDefined (sym : syns) (unitsList d)+  if null defCheck+    then case pq of+      (Right pq') -> do+        let (Quantity baseFac baseUnits _) = convertBase' d pq'+        put $ d `unionDefinitions` emptyDefinitions {+          bases         = M.singleton sym (baseFac, baseUnits)+          , synonyms    = M.fromList $ zip (sym : syns) (repeat sym)+          , unitsList   = sym : syns }+      (Left err) -> lift . Left $ err+    else lift . Left $ UnitAlreadyDefinedError $ head defCheck+++-- | Computes intersection of two lists+checkDefined :: [Symbol] -> [Symbol] -> [Symbol]+checkDefined a b = S.toList $ S.intersection (S.fromList a) (S.fromList b)++-- Convert prefixes and synonyms+preprocessQuantity :: Definitions -> Quantity -> Either QuantityError Quantity+preprocessQuantity d (Quantity x us _)+  | null errs = Right $ Quantity x us' d+  | otherwise = Left  $ head errs+    where ppUnits     = map (preprocessUnit d) us+          (errs, us') = partitionEithers ppUnits++preprocessUnit :: Definitions -> SimpleUnit -> Either QuantityError SimpleUnit+preprocessUnit d (SimpleUnit s _ p)+  | rs `elem` unitsList d = Right $ SimpleUnit ns np p+  | otherwise             = Left  $ UndefinedUnitError s+  where (rp, rs) = prefixParser d s+        np       = prefixSynonyms d M.! rp+        ns       = synonyms d M.! rs+++prefixParser :: Definitions -> String -> (String, String)+prefixParser d input = if input `elem` unitsList d+                          then ("", input)+                          else case P.parse (prefixParser' d) "arithmetic" input of+                            Left _ -> ("", input)+                            Right val -> splitAt (length val) input+++prefixParser' :: Definitions -> P.Parser String+prefixParser' d = do+  pr <- P.choice $ map (P.try . P.string) (prefixes d)+  _  <- P.choice $ map (P.try . P.string) (unitsList d)+  return pr
+ library/Data/Quantities/ExprParser.hs view
@@ -0,0 +1,112 @@+-- | Parse expressions with numbers and units.+--+-- This module provides a basic expression grammar that parses numbers+-- and units.+module Data.Quantities.ExprParser  where++import Control.Applicative ((<*>), (<$>), (*>), (<*))+import Numeric (readFloat)+import System.Environment+import Text.ParserCombinators.Parsec++import Data.Quantities.Data (SimpleUnit(..), Quantity(..), baseQuant,+                             multiplyQuants, divideQuants, exptQuants)++main :: IO ()+main = do+  args <- getArgs+  putStrLn $ readExpr (head args)++readExpr :: String -> String+readExpr input = case parse parseExpr "arithmetic" input of+  Left err  -> "No match: " ++ show err+  Right val -> show val++spaces' :: Parser String+spaces' = many $ char ' '++parseExprQuant :: String -> Either String Quantity+parseExprQuant input = case parse parseExpr "arithmetic" input of+  Left err  -> Left $ "No match: " ++ show err+  Right val -> Right val++-- | Converts string to a Quantity using an expression grammar parser.+parseExpr :: Parser Quantity+parseExpr = spaces' >> parseExpr' <* spaces'++-- parseExpr', parseTerm, parseFactor, parseExp, parseNestedExpr :: Parser Quantity+-- parseExpr'      = try parseTermOp     <|> parseTerm+-- parseTerm       = try parseFactorOp   <|> parseFactor+-- parseFactor     = try parseExpOp      <|> parseExp+-- parseExp        = try parseNestedExpr <|> parseSymbolNum+-- parseNestedExpr = spaces' >> char '(' *> spaces' >> parseExpr' <* spaces' <* char ')' <* spaces' <?> "parseNested"++-- parseExpOp, parseTermOp, parseFactorOp :: Parser Quantity+-- parseExpOp    = parseExp    `chainl1` expOp+-- parseTermOp   = parseTerm   `chainl1` addOp+-- parseFactorOp = parseFactor `chainl1` mulOp++parseExpr', parseFactor, parseExp, parseNestedExpr :: Parser Quantity+parseExpr'      = try parseFactorOp   <|> parseFactor+parseFactor     = try parseExpOp      <|> parseExp+parseExp        = try parseNestedExpr <|> parseSymbolNum+parseNestedExpr = spaces' >> char '(' *> spaces' >> parseExpr' <* spaces' <* char ')' <* spaces' <?> "parseNested"++parseExpOp, parseFactorOp :: Parser Quantity+parseExpOp    = parseExp    `chainl1` expOp+parseFactorOp = parseFactor `chainl1` mulOp+++expOp, mulOp :: Parser (Quantity -> Quantity -> Quantity)+-- addOp = try parseAdd <|> parseSubtract <?> "addOp"+--   where parseAdd      = char '+' >> spaces' >> return (addQuants)+--         parseSubtract = char '-' >> spaces' >> return (subtractQuants)+mulOp = try parseTimes <|> try parseDiv <|> parseImplicitTimes <?> "mulOp"+  where parseTimes         = char '*' >> spaces' >> return multiplyQuants+        parseDiv           = char '/' >> spaces' >> return divideQuants+        parseImplicitTimes = return multiplyQuants+expOp = try (opChoice >> spaces' >> return exptQuants') <?> "expOp"+  where opChoice = string "^" <|> string "**"+++exptQuants' :: Quantity -> Quantity -> Quantity+exptQuants' q (Quantity y [] _) = exptQuants q y+exptQuants' a b  = error $ "Used non-dimensionless exponent in " ++ showq+  where showq = unwords ["(", show a, ") ** (", show b, ")"]++parseSymbolNum :: Parser Quantity+parseSymbolNum = try parseNum <|> parseSymbol'++parseSymbol' :: Parser Quantity+parseSymbol' = do+  neg  <- option "" $ string "-"+  symf <- letter+  rest <- many (alphaNum <|> char '_')+  _ <- spaces'+  return $ baseQuant (timesSign neg 1) [SimpleUnit (symf : rest) "" 1]++parseNum :: Parser Quantity+parseNum = do+  num <- parseNum'+  return $ baseQuant num []++parseNum' :: Parser Double+parseNum' = do+  neg <- option "" $ string "-"+  whole <- many1 digit+  decimal <- option "" $ (:) <$> char '.' <*> many1 digit+  exponential <- option "" parseExponential+  _ <- spaces'+  return $ timesSign neg $ fst $ head $ readFloat $ whole ++ decimal ++ exponential++parseExponential :: Parser String+parseExponential = do+  e <- string "e"+  neg <- option "" $ string "+" <|> string "-"+  pow <- many1 digit+  return $ e ++ neg ++ pow++timesSign :: String -> Double -> Double+timesSign sign x+  | sign == "-" = -x+  | otherwise   = x
+ quantities.cabal view
@@ -0,0 +1,60 @@+name:                 quantities+version:              0.1.0+author:               John David Reaver <jdreaver@adlerhorst.com>+maintainer:           John David Reaver <jdreaver@adlerhorst.com>+build-type:           Simple+cabal-version:        >= 1.18+copyright:            2014 John David Reaver+license:              BSD3+license-file:         LICENSE+synopsis:             Unit conversion and manipulation library.+description:          A library for creating and manipulating physical+                      quantities, which are a numerical value+                      associated with a unit of measurement. Included+                      is an expression parser and a huge list of+                      predefined quantities with which to parse+                      strings into a Quantity datatype. Once created,+                      a quantity can be converted to different units+                      or queried for its dimensionality. A user can+                      also operate on quantities arithmetically, and+                      doing so uses automatic unit conversion and+                      simplifcation.++category:             Data, Math, Physics+homepage:             http://github.com/jdreaver/quantities+extra-source-files:   CHANGES.md+++library+    default-language: Haskell2010+    exposed-modules:  Data.Quantities+                    , Data.Quantities.DefaultUnits+    hs-source-dirs:   library+    ghc-options:      -Wall+    build-depends:    base >=4 && < 5, containers, mtl, parsec+    other-modules:    Data.Quantities.Convert+                    , Data.Quantities.Constructors+                    , Data.Quantities.Data++                    , Data.Quantities.Definitions+                    , Data.Quantities.DefinitionParser+                    , Data.Quantities.ExprParser++test-suite hspec+    default-language: Haskell2010+    ghc-options:      -Wall+    hs-source-dirs:   test-suite library+    main-is:          Spec.hs+    type:             exitcode-stdio-1.0+    build-depends:    base >=4 && < 5, quantities, hspec, containers, mtl, parsec++test-suite hlint+    build-depends:    base, hlint+    default-language: Haskell2010+    hs-source-dirs:   test-suite+    main-is:          HLint.hs+    type:             exitcode-stdio-1.0++source-repository head+    type:     git+    location: https://github.com/jdreaver/quantities.git
+ test-suite/HLint.hs view
@@ -0,0 +1,15 @@+module Main (main) where++import Language.Haskell.HLint (hlint)+import System.Exit (exitFailure, exitSuccess)++arguments :: [String]+arguments =+    [ "library"+    , "test-suite"+    ]++main :: IO ()+main = do+    hints <- hlint arguments+    if null hints then exitSuccess else exitFailure
+ test-suite/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}