jinquantities (empty) → 0.1.0
raw patch · 17 files changed
+1503/−0 lines, 17 filesdep +Globdep +basedep +containerssetup-changed
Dependencies added: Glob, base, containers, doctest, hlint, hspec, mtl, parsec, process, quantities, regex-compat
Files
- CHANGES.md +6/−0
- LICENSE +29/−0
- Setup.hs +2/−0
- jinquantities.cabal +82/−0
- library/Data/Quantities.hs +127/−0
- library/Data/Quantities/Constructors.hs +65/−0
- library/Data/Quantities/Convert.hs +104/−0
- library/Data/Quantities/Data.hs +250/−0
- library/Data/Quantities/DefaultUnits.hs +337/−0
- library/Data/Quantities/DefinitionParser.hs +107/−0
- library/Data/Quantities/Definitions.hs +90/−0
- library/Data/Quantities/ExprParser.hs +237/−0
- quantities.hs +19/−0
- test-suite/DocCoverage.hs +25/−0
- test-suite/DocTest.hs +7/−0
- test-suite/HLint.hs +15/−0
- test-suite/Spec.hs +1/−0
+ CHANGES.md view
@@ -0,0 +1,6 @@++# jinquantities changelog+---++## 0.1.0 (2018-09-07)+- Fork from https://github.com/jdreaver/quantities
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2018-2019, Eliott Tixier, Novadiscovery+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
+ jinquantities.cabal view
@@ -0,0 +1,82 @@+name: jinquantities+version: 0.1.0+author: Eliott Tixier <eliott.tixier@novadiscovery.com>+maintainer: Eliott Tixier <eliott.tixier@novadiscovery.com>+build-type: Simple+cabal-version: >= 1.18+copyright: Copyright (c) 2018-2019 Eliott Tixier, Novadiscovery+license: BSD3+license-file: LICENSE+synopsis: Unit conversion and manipulation library.+description: Credit goes to https://github.com/jdreaver/quantities+ from which this package is initially a fork.+ 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+ simplification.++category: Data, Math, Physics+homepage: http://github.com/eltix/quantities+extra-source-files: CHANGES.md+++library+ default-language: Haskell2010+ exposed-modules: Data.Quantities+ , Data.Quantities.Convert+ , Data.Quantities.Constructors+ , Data.Quantities.Data+ , Data.Quantities.DefaultUnits+ , Data.Quantities.Definitions+ , Data.Quantities.DefinitionParser+ , Data.Quantities.ExprParser+ hs-source-dirs: library+ ghc-options: -Wall+ build-depends: base >=4 && < 5, containers, mtl, parsec++executable quantities+ default-language: Haskell2010+ Hs-Source-Dirs: .+ Main-Is: quantities.hs+ build-depends: base >=4 && < 5, quantities, containers, mtl, parsec+ Buildable: True++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++test-suite doctest+ build-depends: base, doctest, Glob+ default-language: Haskell2010+ hs-source-dirs: test-suite+ main-is: DocTest.hs+ type: exitcode-stdio-1.0++test-suite coverage+ build-depends: base, process, regex-compat+ default-language: Haskell2010+ hs-source-dirs: test-suite+ main-is: DocCoverage.hs+ type: exitcode-stdio-1.0++source-repository head+ type: git+ location: https://github.com/etixier/quantities.git
+ library/Data/Quantities.hs view
@@ -0,0 +1,127 @@+-- | 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 simplification.+++module Data.Quantities+ (+ -- * Constructors+ -- $constructors+ fromString+ , unitsFromString+ , Definitions+ , Quantity+ , magnitude+ , units+ , CompoundUnit+ -- * Conversion+ -- $conversion+ , convert+ , convertBase+ , dimensionality+ -- * Quantity arithmetic+ -- $arithmetic+ , addQuants+ , subtractQuants+ , multiplyQuants+ , divideQuants+ , exptQuants+ -- * Custom definitions+ -- $custom-defs+ , fromString'+ , readDefinitions+ , defaultDefString+ -- * Error type+ , QuantityError(..)+ , QuantityComputation+ ) where+++import Data.Quantities.Constructors (fromString, fromString', unitsFromString)+import Data.Quantities.Convert (convert, convertBase, addQuants, subtractQuants,+ dimensionality)+import Data.Quantities.Data+import Data.Quantities.Definitions (readDefinitions)+import Data.Quantities.DefaultUnits (defaultDefString)+++-- $setup+-- >>> import Control.Applicative+++-- $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 '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+++-- $custom-defs+--+-- You don't have to use the default definitions provided by+-- 'defaultDefString'. Here is an example of adding a new unit called+-- @metric_foot@.+--+-- >>> let myDefString = defaultDefString ++ "\n" ++ "metric_foot = 300mm"+-- >>> let (Right d') = readDefinitions myDefString+-- >>> let myFromString = fromString' d'+-- >>> myFromString "metric_foot"+-- Right 1.0 metric_foot+-- >>> convertBase <$> myFromString "metric_foot"+-- Right 0.3 meter+--+-- It is usually much easier to copy the source code for 'defaultDefString' and+-- add your definitions in the appropriate spot (for example, put @metric_foot@+-- next to the other unit definitions). Then, use 'fromString'' to create your+-- Quantity constructor.+--+-- NOTE: It is very important not to perform conversions on two quantities from+-- different Definitions. Most of the error checking for undefined units is+-- done when a unit is created, and not when performing conversions. We try to+-- catch when different definitions are used.+--+-- >>> let (Right m) = fromString "m"+-- >>> let (Right ft) = myFromString "ft"+-- >>> convert m (units ft)+-- Left (DifferentDefinitionsError meter foot)
+ library/Data/Quantities/Constructors.hs view
@@ -0,0 +1,65 @@+-- | Defines the common constructors used to build quantities.+module Data.Quantities.Constructors where++import Data.Quantities.Data+import Data.Quantities.DefaultUnits (defaultDefString)+import Data.Quantities.Definitions (readDefinitions)+import Data.Quantities.ExprParser (parseExprQuant)++-- | Default set of definitions that come predefined.+defaultDefinitions :: Either (QuantityError Double) Definitions+defaultDefinitions = readDefinitions defaultDefString++-- $setup+-- >>> import Data.Quantities++-- | Create a Quantity by parsing a string. Uses an 'UndefinedUnitError' for+-- undefined units. Handles arithmetic expressions as well.+--+-- >>> fromString "25 m/s"+-- Right 25.0 meter / second+-- >>> fromString "fakeunit"+-- Left (UndefinedUnitError "fakeunit")+-- >>> fromString "ft + 12in"+-- Right 2.0 foot+--+-- This function also supports unit conversions, by placing \"=>\" in between+-- two valid expressions. This behavior is undefined (and returns a+-- 'ScalingFactorError') if the quantity to be converted to has a magnitude.+--+-- >>> fromString "min => s"+-- Right 60.0 second+-- >>> fromString "2 ft + 6 in => ft"+-- Right 2.5 foot+-- >>> fromString "m => 3 ft"+-- Left (ScalingFactorError 3.0 foot)+--+-- Make sure not to use dimensional quantities in exponents.+--+-- >>> fromString "m ** 2"+-- Right 1.0 meter ** 2+-- >>> fromString "m ** (2s)"+-- Left (ParserError "Used non-dimensionless exponent in ( Right 1.0 meter ) ** ( Right 2.0 second )")+fromString :: String -> Either (QuantityError Double) (Quantity Double)+fromString s = case defaultDefinitions of+ (Right d) -> parseExprQuant d s+ (Left d) -> Left d+++-- | Create quantities with custom definitions.+--+-- >>> let myDefString = defaultDefString ++ "\nmy_unit = 100 s"+-- >>> let (Right d) = readDefinitions myDefString+-- >>> let myFromString = fromString' d+-- >>> myFromString "25 my_unit"+-- Right 25.0 my_unit+fromString' :: Definitions -> String -> Either (QuantityError Double) (Quantity Double)+fromString' = parseExprQuant+++-- | Parse units from a string. Equivalent to @fmap units . fromString@+--+-- >>> unitsFromString "N * s"+-- Right newton second+unitsFromString :: String -> Either (QuantityError Double) CompoundUnit+unitsFromString = fmap units . fromString
+ library/Data/Quantities/Convert.hs view
@@ -0,0 +1,104 @@+-- | Module to perform unit conversions, compute dimensionality, and convert to+-- base units.+module Data.Quantities.Convert where++import Data.List (sort)+import qualified Data.Map as M++import Data.Quantities.Data++-- $setup+-- >>> import Control.Applicative+-- >>> import Data.Quantities++-- | Convert quantity to given units.+--+-- >>> convert <$> fromString "m" <*> unitsFromString "ft"+-- Right (Right 3.280839895013123 foot)+convert :: (Fractional a) => Quantity a -> CompoundUnit ->+ Either (QuantityError a) (Quantity a)+convert q us+ | hq /= hus = Left $ DifferentDefinitionsError (units q) us+ | otherwise = convert' (defs us) q us+ where hq = defStringHash (defs' q)+ hus = defStringHash (defs us)+++-- | Convert a quantity to its base units.+--+-- >>> convertBase <$> fromString "newton"+-- Right 1000.0 gram meter / second ** 2+convertBase :: (Fractional a) => Quantity a -> Quantity a+convertBase x = convertBase' (defs' x) x+++-- | Convert quantity to given units.+convert' :: (Fractional a) => Definitions -> Quantity a -> CompoundUnit ->+ Either (QuantityError a) (Quantity a)+convert' d q us'+ | dimq /= dimus = Left $ DimensionalityError (CompoundUnit d dimq) (CompoundUnit d dimus)+ | otherwise = Right $ Quantity (mb / realToFrac mb') us'+ where mb = magnitude $ convertBase' d q+ mb' = magnitude $ toBase d (sUnits us')+ dimq = dimensionality' d (units' q)+ dimus = dimensionality' d (sUnits us')++++-- | Convert a quantity to its base units.+convertBase' :: (Fractional a) => Definitions -> Quantity a -> Quantity a+convertBase' d (Quantity m us) = Quantity (m * realToFrac mb) ub+ where (Quantity mb ub) = toBase d (sUnits us)+++-- | Converts a composite unit to its base quantity+toBase :: Definitions -> [SimpleUnit] -> Quantity Double+toBase d = foldr (multiplyQuants . simpleToBase d) unityQuant+ where unityQuant = Quantity 1 (CompoundUnit d [])+++-- | Converts a simple unit to its base quantity.+simpleToBase :: Definitions -> SimpleUnit -> Quantity Double+simpleToBase d (SimpleUnit sym pre pow) = Quantity m (CompoundUnit d us)+ 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+dimensionality :: Quantity a -> CompoundUnit+dimensionality q = CompoundUnit (defs' q) dimUnits+ where dimUnits = dimensionality' (defs' q) (units' q)++-- | Computes dimensionality of a list of SimpleUnits. Stores the+-- dimensionality as a list of SimpleUnits as well, so we don't need a whole+-- new type.+dimensionality' :: Definitions -> [SimpleUnit] -> [SimpleUnit]+dimensionality' d us = sort $ map dim ub+ where ub = units' $ 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 :: (Fractional a) => Quantity a -> Quantity a ->+ Either (QuantityError a) (Quantity a)+addQuants = linearQuants (+)+++-- | Subtract two quantities. Second quantity is converted to units of+-- first quantity.+subtractQuants :: (Fractional a) => Quantity a -> Quantity a ->+ Either (QuantityError a) (Quantity a)+subtractQuants = linearQuants (-)++-- | Helper function used in addQuants and subtractQuants.+linearQuants :: (Fractional a) => (a -> a -> a) -> Quantity a -> Quantity a+ -> Either (QuantityError a) (Quantity a)+linearQuants f (Quantity m1 u1) q2 = case q of+ (Right q') -> Right $ Quantity (f m1 (magnitude q')) u1+ (Left err) -> Left err+ where q = convert q2 u1
+ library/Data/Quantities/Data.hs view
@@ -0,0 +1,250 @@+-- | Base module for all data structures.+module Data.Quantities.Data where++import Data.List (partition, sort)+import qualified Data.Map as M++-- $setup+-- >>> import Control.Applicative+-- >>> import Data.Quantities++-- | 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 ++ " ** " ++ showPower p+ where sym = pr ++ s++-- | Data type to hold compound units, which are simple units multiplied+-- together.+data CompoundUnit = CompoundUnit { defs :: Definitions+ -- ^ Definitions used to create the units.+ , sUnits :: [SimpleUnit]+ -- ^ List of SimpleUnits that is interpreted+ -- as the units being multiplied together.+ } deriving (Eq, Ord)++instance Show CompoundUnit where+ show (CompoundUnit _ us) = unwords . map showCompUnit' $ showSort us++-- | Show a single unit, but prepend with '/' if negative+showCompUnit' :: SimpleUnit -> String+showCompUnit' su@(SimpleUnit _ _ p)+ | p < 0 = "/ " ++ show (su { power = -p })+ | otherwise = show su++{-# ANN showPower "HLint: ignore Too strict if" #-}+-- | Removes decimal if almost integer.+showPower :: Double -> String+showPower d = if isInt d then show (round d :: Integer) else show d+ where isInt x = x == fromInteger (round x)++-- | Will be used when we allow pretty printing of fractional units.+showPrettyNum :: (Show a, Num a) => a -> String+showPrettyNum x = map (pretty M.!) $ show x+ where pretty = M.fromList $ zip "0123456789.-" "⁰¹²³⁴⁵⁶⁷⁸⁹·⁻"+++-- | Combination of magnitude and units.+data Quantity a = Quantity+ { magnitude :: a -- ^ Numerical magnitude of quantity.+ --+ -- >>> magnitude <$> fromString "100 N * m"+ -- Right 100.0+ , units :: CompoundUnit -- ^ Units associated with quantity.+ --+ -- >>> units <$> fromString "3.4 m/s^2"+ -- Right meter / second ** 2+ } deriving (Ord)+++-- | Convenience function to extract SimpleUnit collection from Quantity's+-- CompoundUnit.+units' :: Quantity a -> [SimpleUnit]+units' = sUnits . units++-- | Convenience function to extract Definitions from Quantity's CompoundUnit.+defs' :: Quantity a -> Definitions+defs' = defs . units++instance (Show a) => Show (Quantity a) where+ show (Quantity m us) = show m ++ " " ++ show us+++-- | Convenience function to make quantity with no definitions.+baseQuant :: a -> [SimpleUnit] -> Quantity a+baseQuant m us = Quantity m (CompoundUnit emptyDefinitions us)++-- | Sort units but put negative units at end.+showSort :: [SimpleUnit] -> [SimpleUnit]+showSort c = pos ++ neg+ where (pos, neg) = partition (\q -> power q > 0) c++instance (Eq a) => Eq (Quantity a) where+ (Quantity m1 u1) == (Quantity m2 u2) = m1 == m2 && sort (sUnits u1) == sort (sUnits u2)+++-- | Custom error type+data QuantityError a = UndefinedUnitError String+ -- ^ Used when trying to parse an undefined unit.+ | DimensionalityError CompoundUnit CompoundUnit+ -- ^ 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.+ | DifferentDefinitionsError CompoundUnit CompoundUnit+ -- ^ Used when two quantities come from different+ -- Definitions.+ | ScalingFactorError (Quantity a)+ -- ^ Used when a scaling factor is present in a unit+ -- conversion.+ deriving (Show, Eq)+++-- | Useful for monadic computations with '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 a = Either (QuantityError a)++-- | Combines equivalent units and removes units with powers of zero.+reduceUnits :: Quantity a -> Quantity a+reduceUnits q = q { units = newUnits }+ where newUnits = (units q) { sUnits = reduceUnits' (units' q) }++-- | Helper function for reduceUnits.+reduceUnits' :: [SimpleUnit] -> [SimpleUnit]+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++-- | Removes units with powers of zero that are left over from other+-- computations.+removeZeros :: [SimpleUnit] -> [SimpleUnit]+removeZeros [] = []+removeZeros (SimpleUnit _ _ 0.0 : xs) = removeZeros xs+removeZeros (x:xs) = x : removeZeros xs++-- | Negate the powers of a list of SimpleUnits.+invertUnits :: [SimpleUnit] -> [SimpleUnit]+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 :: (Num a) => Quantity a -> Quantity a -> Quantity a+multiplyQuants x y = reduceUnits $ Quantity mag newUnits+ where mag = magnitude x * magnitude y+ newUnits = (units x) { sUnits = units' x ++ units' y }++-- | Divides two quantities.+divideQuants :: (Fractional a) => Quantity a -> Quantity a -> Quantity a+divideQuants x y = reduceUnits $ Quantity mag newUnits+ where mag = magnitude x / magnitude y+ newUnits = (units x) { sUnits = units' x ++ invertUnits (units' y) }++-- | Exponentiates a quantity with an integer+exptQuants :: (Real a, Floating a) => Quantity a -> a -> Quantity a+exptQuants (Quantity x u) y = reduceUnits $ Quantity (x**y) newUnits+ where expUnits = map (\(SimpleUnit s pr p) -> SimpleUnit s pr (p * realToFrac y))+ newUnits = u { sUnits = expUnits (sUnits u) }++-- | Data type for the three definition types. Used to hold definitions+-- information when parsing.+data Definition = PrefixDefinition { defPrefix :: Symbol+ , factor :: Double+ , defSynonyms :: [Symbol]}+ | BaseDefinition { base :: Symbol+ , dimBase :: Symbol+ , defSynonyms ::[Symbol]}+ | UnitDefinition { defSymbol :: Symbol+ , quantity :: Quantity Double+ , defSynonyms :: [Symbol]} deriving (Show, Eq, Ord)++-- | Holds information about defined units, prefixes, and bases. Used when+-- parsing new units and performing units conversions.+data Definitions = Definitions { bases :: M.Map String (Double, [SimpleUnit])+ -- ^ Map from symbol to base units and+ -- conversion factor to those units.+ , synonyms :: M.Map String String+ -- ^ Map from alias to symbol. Symbols without+ -- aliases are present as identity maps.+ , unitsList :: [String]+ -- ^ List of all units (no aliases). Used in+ -- prefix parser, and to detect duplicate+ -- definitions.+ , prefixes :: [String]+ -- ^ List of all prefixes (no aliases). Used+ -- in prefix parser, and to detect duplicate+ -- prefix definitions.+ , prefixValues :: M.Map String Double+ -- ^ Multiplicative factor of prefixes.+ , prefixSynonyms :: M.Map String String+ -- ^ Map from prefix alias to prefix.+ , unitTypes :: M.Map String String+ -- ^ Map from base symbols to unit types.+ , defStringHash :: Int+ -- ^ Hash of the definitions string used to+ -- create definitions. Defaults to -1 if+ -- modified or no string was used.+ } deriving (Show, Ord)++instance Eq Definitions where+ d1 == d2 = defStringHash d1 == defStringHash d2++-- | Default, empty set of definitions.+emptyDefinitions :: Definitions+emptyDefinitions = Definitions { bases = M.empty+ , synonyms = M.empty+ , unitsList = []+ , prefixes = []+ , prefixValues = M.fromList [("", 1)]+ , prefixSynonyms = M.fromList [("", "")]+ , unitTypes = M.empty+ , defStringHash = -1 }+++-- | 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+ , defStringHash = -1 }
+ library/Data/Quantities/DefaultUnits.hs view
@@ -0,0 +1,337 @@+-- | Holds the default definition string.+module Data.Quantities.DefaultUnits (defaultDefString) where++-- | View the source code for this declaration to see what units and prefixes+-- are defined by default.+--+-- 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. Users can copy this file+-- into their source and modify definitions, or simply add a few definitions to+-- the end of this string.+--+-- 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 @@+-- | Uses parsec to parse definition lines.+module Data.Quantities.DefinitionParser where++import Control.Applicative ((<*))+import Text.ParserCombinators.Parsec++import Data.Quantities.Data+import Data.Quantities.ExprParser (parseMultExpr)++-- | Parse multiline string of definitions (say, from a file) into a+-- list of definitions.+parseDefinitions :: String -> [Definition]+parseDefinitions input = case parse parseDefinitions' "Input File Parser" input of+ Left err -> error (show err) >> []+ Right val -> val++-- | Parsec parser for definitions.+parseDefinitions' :: Parser [Definition]+parseDefinitions' = 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")++-- | Custom eol parsec parser.+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++-- | Parses a unit definition. Example: foot = 12 in = ft = feet+parseUnitDef :: Parser Definition+parseUnitDef = do+ sym <- parseSymbol <* spaces <* char '='+ quant <- parseMultExpr+ spaces+ -- skipMany comment+ return $ UnitDefinition sym quant []++-- | Parses the synonyms at the end of a base or unit definition.+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++-- | Parse the base of a base definition. Example: [length] -> length+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++-- | Parse the prefix part of a prefix definition. Example: yocto- -> yocto+parsePrefix :: Parser (Symbol, Double)+parsePrefix = do+ pre <- many1 letter <* char '-' <* spaces <* char '='+ facQuant <- spaces >> parseMultExpr+ spaces+ if null (units' facQuant) then+ return (pre, magnitude facQuant)+ else fail "No units allowed in prefix definitions"++-- | Parse the synonyms for a prefix definition.+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,90 @@+-- | This module builds a Definitions object from a string.+module Data.Quantities.Definitions where++import Control.Applicative ((<$>))+import Control.Monad.State+import Data.Bits (xor)+import Data.List (foldl')+import qualified Data.Map as M+import qualified Data.Set as S++import Data.Quantities.Convert (convertBase')+import Data.Quantities.Data+import Data.Quantities.DefinitionParser (parseDefinitions)+import Data.Quantities.ExprParser (preprocessQuantity)++-- | Convert string of definitions into 'Definitions' structure. See source+-- code for 'Data.Quantities.defaultDefString' for an example.+readDefinitions :: String -> Either (QuantityError Double) Definitions+readDefinitions s = addDefinitionsHash s <$> d+ where d = makeDefinitions (parseDefinitions s)++-- | Monad used for addDefinition.+type DefineMonad = StateT Definitions (Either (QuantityError Double))++-- | Converts a list of definitions to the Definitions data structure. Modifies+-- an emptyDefinitions object by combining the incremental additions of each+-- Definition.+makeDefinitions :: [Definition] -> Either (QuantityError Double) Definitions+makeDefinitions ds = execStateT (mapM addDefinition ds) emptyDefinitions++-- | Add one definition to the definitions. Creates a new Definitions object+-- using the information in the Definition, and then unions the Definitions in+-- the state monad with this new object.+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, sUnits 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)+++-- | Variant of the DJB2 hash; <http://stackoverflow.com/a/9263004/1333514>+hash :: String -> Int+hash = foldl' (\h c -> 33*h `xor` fromEnum c) 5381++-- | Add a hash of the definitions string to a group of Definitions. Meant to+-- be the last step, after definitions are created. Used for Definitions+-- comparison.+addDefinitionsHash :: String -> Definitions -> Definitions+addDefinitionsHash s d = d { defStringHash = hash s }
+ library/Data/Quantities/ExprParser.hs view
@@ -0,0 +1,237 @@+-- | 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 Data.Either (partitionEithers)+import qualified Data.Map as M+import Numeric (readFloat)+import Text.ParserCombinators.Parsec++import Data.Quantities.Convert (addQuants, subtractQuants, convert)+import Data.Quantities.Data++-- | Alternate definition for spaces. Just actual spaces.+spaces' :: Parser String+spaces' = many $ char ' '++-- | Parse quantity expression; addition and subtraction allowed.+parseExprQuant :: Definitions -> String ->+ Either (QuantityError Double) (Quantity Double)+parseExprQuant d input = case parse (parseExpr d) "arithmetic" input of+ Left err -> Left $ ParserError $ show err+ Right val -> val++-- | Simple type used for shorthand+type EQuant = Either (QuantityError Double) (Quantity Double)++-- | Using already compiled definitions, parse expression. Also allows for+-- expressions like "exp1 => exp2" in the middle, which converts the quantity+-- exp1 into the units of the quantity exp2.+parseExpr :: Definitions -> Parser EQuant+parseExpr d = (try (parseConvertExpr d) <|> parseSingle) <* eof+ where parseSingle = spaces >> parseExpr' d <* spaces++-- | Parser that accepts "=>" in between two expressions.+parseConvertExpr :: Definitions -> Parser EQuant+parseConvertExpr d = do+ _ <- spaces'+ exp1 <- parseExpr' d <* spaces+ exp2 <- string "=>" >> spaces >> parseExpr' d+ _ <- spaces'+ return $ do+ e1 <- exp1+ e2 <- exp2+ u2 <- units <$> exp2+ case magnitude e2 of+ 1.0 -> convert e1 u2+ _ -> Left $ ScalingFactorError e2++parseExpr', parseTerm :: Definitions -> Parser EQuant+parseFactor, parseExpt, parseNestedExpr :: Definitions -> Parser EQuant+parseExpr' d = try (parseTermOp d) <|> parseTerm d+parseTerm d = try (parseFactorOp d) <|> parseFactor d+parseFactor d = try (parseExptOp d) <|> parseExpt d+parseExpt d = try (parseNestedExpr d) <|> parseESymbolNum d+parseNestedExpr d = spaces' >> char '(' *> spaces' >>+ parseExpr' d+ <* spaces' <* char ')' <* spaces' <?> "parseNested"++parseExptOp, parseTermOp, parseFactorOp :: Definitions -> Parser EQuant+parseExptOp d = parseExpt d `chainl1` exptOp+parseTermOp d = parseTerm d `chainl1` addOp+parseFactorOp d = parseFactor d `chainl1` mulOp+++exptOp, addOp, mulOp :: Parser (EQuant -> EQuant -> EQuant)+addOp = try parseAdd <|> parseSubtract <?> "addOp"+ where parseAdd = char '+' >> spaces' >> return addEQuants+ parseSubtract = char '-' >> spaces' >> return subtractEQuants+mulOp = try parseTimes <|> try parseDiv <|> parseImplicitTimes <?> "mulOp"+ where parseTimes = char '*' >> spaces' >> return multiplyEQuants+ parseDiv = divOp >> spaces' >> return divideEQuants+ where divOp = try (string "/") <|> string "per "+ parseImplicitTimes = return multiplyEQuants+exptOp = try (opChoice >> spaces' >> return exptEQuants) <?> "expOp"+ where opChoice = string "^" <|> string "**"++-- | Modification of addQuants to account for Either QuantityError Quantity.+addEQuants :: EQuant -> EQuant -> EQuant+addEQuants (Right a) (Right b) = addQuants a b+addEQuants (Left a) _ = Left a+addEQuants _ (Left b) = Left b++-- | Modification of subtractQuants to account for Either QuantityError Quantity.+subtractEQuants :: EQuant -> EQuant -> EQuant+subtractEQuants (Right a) (Right b) = subtractQuants a b+subtractEQuants (Left a) _ = Left a+subtractEQuants _ (Left b) = Left b++-- | Modification of multiplyQuants to account for Either QuantityError Quantity.+multiplyEQuants :: EQuant -> EQuant -> EQuant+multiplyEQuants (Right a) (Right b) = Right $ multiplyQuants a b+multiplyEQuants (Left a) _ = Left a+multiplyEQuants _ (Left b) = Left b++-- | Modification of divideQuants to account for Either QuantityError Quantity.+divideEQuants :: EQuant -> EQuant -> EQuant+divideEQuants (Right a) (Right b) = Right $ divideQuants a b+divideEQuants (Left a) _ = Left a+divideEQuants _ (Left b) = Left b++-- | Modification of exptQuants to account for Either QuantityError Quantity.+-- Returns error if dimensional quantity used in exponent.+exptEQuants :: EQuant -> EQuant -> EQuant+exptEQuants (Left a) _ = Left a+exptEQuants _ (Left b) = Left b+exptEQuants (Right q) (Right (Quantity y (CompoundUnit _ []))) = Right $ exptQuants q y+exptEQuants a b = Left $ ParserError $ "Used non-dimensionless exponent in " ++ showq+ where showq = unwords ["(", show a, ") ** (", show b, ")"]++-- | Modification of parseSymbolNum to handle parsing errors.+parseESymbolNum :: Definitions -> Parser EQuant+parseESymbolNum d = try (parseENum d) <|> parseESymbol d++-- | Parses a symbol and then parses a prefix form that symbol.+parseESymbol :: Definitions -> Parser EQuant+parseESymbol d = do+ q <- parseSymbol'+ return $ preprocessQuantity d q++-- | Parse a number and insert the given definitions into the CompoundUnit.+parseENum :: Definitions -> Parser EQuant+parseENum d = do+ q <- parseNum+ return $ Right $ q { units = (units q) { defs = d } }++-- | Parses out prefixes and aliases from quantity's units.+preprocessQuantity :: Definitions -> Quantity Double -> EQuant+preprocessQuantity d (Quantity x us)+ | null errs = Right $ Quantity x (CompoundUnit d us')+ | otherwise = Left $ head errs+ where ppUnits = map (preprocessUnit d) (sUnits us)+ (errs, us') = partitionEithers ppUnits++-- | Parses prefix and alias, if applicable, from a SimpleUnit.+preprocessUnit :: Definitions -> SimpleUnit -> Either (QuantityError Double) 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++-- | Try to parse a prefix from a symbol. Otherwise, just return the symbol.+prefixParser :: Definitions -> String -> (String, String)+prefixParser d input = if input `elem` unitsList d+ then ("", input)+ else case parse (prefixParser' d) "arithmetic" input of+ Left _ -> ("", input)+ Right val -> splitAt (length val) input++-- | Helper function for prefixParser that is a Parsec parser.+prefixParser' :: Definitions -> Parser String+prefixParser' d = do+ pr <- choice $ map (try . string) (prefixes d)+ _ <- choice $ map (try . string) (unitsList d)+ return pr++-- | Converts string to a Quantity using an expression grammar parser. This+-- parser does not parser addition or subtraction, and is used for unit+-- definitions.+parseMultExpr :: Parser (Quantity Double)+parseMultExpr = spaces' >> parseMultExpr' <* spaces'++parseMultExpr', parseMultFactor, parseMultExpt, parseMultNestedExpr :: Parser (Quantity Double)+parseMultExpr' = try parseMultFactorOp <|> parseMultFactor+parseMultFactor = try parseMultExptOp <|> parseMultExpt+parseMultExpt = try parseMultNestedExpr <|> parseSymbolNum+parseMultNestedExpr = spaces' >> char '(' *> spaces' >>+ parseMultExpr'+ <* spaces' <* char ')' <* spaces' <?> "parseNested"+++parseMultExptOp, parseMultFactorOp :: Parser (Quantity Double)+parseMultExptOp = parseMultExpt `chainl1` exptMultOp+parseMultFactorOp = parseMultFactor `chainl1` mulMultOp++exptMultOp, mulMultOp :: Parser (Quantity Double -> Quantity Double -> Quantity Double)+mulMultOp = try parseTimes <|> try parseDiv <|> parseImplicitTimes <?> "mulMultOp"+ where parseTimes = char '*' >> spaces' >> return multiplyQuants+ parseDiv = char '/' >> spaces' >> return divideQuants+ parseImplicitTimes = return multiplyQuants+exptMultOp = try (opChoice >> spaces' >> return exptMultQuants') <?> "expMultOp"+ where opChoice = string "^" <|> string "**"++exptMultQuants' :: (Quantity Double -> Quantity Double -> Quantity Double)+exptMultQuants' q (Quantity y (CompoundUnit _ [])) = exptQuants q y+exptMultQuants' a b = error $ "Used non-dimensionless exponent in " ++ showq+ where showq = unwords ["(", show a, ") ** (", show b, ")"]++-- | Parse either a symbol or a number.+parseSymbolNum :: Parser (Quantity Double)+parseSymbolNum = try parseNum <|> parseSymbol'++-- | Parse a symbol with an optional negative sign. A symbol can contain+-- alphanumeric characters and the character '_'.+parseSymbol' :: Parser (Quantity Double)+parseSymbol' = do+ neg <- option "" $ string "-"+ symf <- letter+ rest <- many (alphaNum <|> char '_')+ _ <- spaces'+ return $ baseQuant (timesSign neg 1) [SimpleUnit (symf : rest) "" 1]++-- | Parent function for parseNum' to parse a number.+parseNum :: Parser (Quantity Double)+parseNum = do+ num <- parseNum'+ return $ baseQuant num []++-- | Meat of number parser. Parse digits with an optional negative sign and+-- optional exponential. For example, -5.2e4.+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++-- | Parses just the exponential part of a number. For example, parses "4" from+-- "-5.2e4".+parseExponential :: Parser String+parseExponential = do+ e <- string "e"+ neg <- option "" $ string "+" <|> string "-"+ pow <- many1 digit+ return $ e ++ neg ++ pow++-- | Negate a number if the first argument is a negative sign.+timesSign :: String -> Double -> Double+timesSign sign x+ | sign == "-" = -x+ | otherwise = x
+ quantities.hs view
@@ -0,0 +1,19 @@+import System.Environment+import System.Exit++import Data.Quantities++main :: IO ()+main = getArgs >>= parse++parse :: [String] -> IO ()+parse ["-h"] = usage >> exit+parse ["-v"] = version >> exit+parse [] = usage >> exit+parse [s] = putStr $ (++ "\n") $ either show show $ fromString s+parse _ = usage >> Main.die++usage = putStrLn "Usage: quantities [-vh] expression"+version = putStrLn "Haskell quantities 0.3.0"+exit = exitSuccess+die = exitWith (ExitFailure 1)
+ test-suite/DocCoverage.hs view
@@ -0,0 +1,25 @@+module Main (main) where++import Data.List (genericLength)+import Data.Maybe (catMaybes)+import System.Exit (exitFailure, exitSuccess)+import System.Process (readProcess)+import Text.Regex (matchRegex, mkRegex)++average :: (Fractional a, Real b) => [b] -> a+average xs = realToFrac (sum xs) / genericLength xs++expected :: Fractional a => a+expected = 90++main :: IO ()+main = do+ output <- readProcess "cabal" ["haddock"] ""+ if average (match output) >= expected+ then exitSuccess+ else putStr output >> exitFailure++match :: String -> [Int]+match = fmap read . concat . catMaybes . fmap (matchRegex pattern) . lines+ where+ pattern = mkRegex "^ *([0-9]*)% "
+ test-suite/DocTest.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "library/**/*.hs" >>= doctest
+ 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 #-}