prefix-units (empty) → 0.1.0

raw patch · 8 files changed

+1098/−0 lines, 8 filesdep +Cabaldep +QuickCheckdep +basesetup-changed

Dependencies added: Cabal, QuickCheck, base, prefix-units, test-framework, test-framework-quickcheck2

Files

• CHANGES +3/−0
• Data/Prefix/Units.hs +549/−0
• LICENSE +28/−0
• Makefile +26/−0
• README.md +42/−0
• Setup.hs +2/−0
• prefix-units.cabal +98/−0
• tests/Properties.hs +350/−0

@@ -0,0 +1,3 @@+Version 0.1.0++* Initial release

@@ -0,0 +1,549 @@+{-++Copyright 2012, Google Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.+    * 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.+    * Neither the name of Google Inc. 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+OWNER 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.++-}++{- | Definitions and functions for parsing and formatting prefix units.++This module defines the type 'Unit' and associated functions for+parsing numbers containing a prefix unit (e.g. @100M@) into+corespondingly scaled values (for the above example, @100000000@), and+for formatting numbers.++The units definition is taken from the man page @units(7)@ and the web+sites <http://physics.nist.gov/cuu/Units/prefixes.html> and+<http://physics.nist.gov/cuu/Units/binary.html>.++Since a give prefix unit (e.g. @m@) can be interpreted in different+ways, the module offers various ways to interpret this:++* in a binary context (e.g. when talking about memory), this will be+  interpreted as 2^20 (see 'ParseBinary')++* in a SI context dealing with multiples, this will be intepreted as+  10^3 (see 'ParseKMGT')++* in an exact parsing mode, this will be interpreded as the \"milli\"+  prefix, i.e. 10^-3 (see 'ParseExact')++The different parsing mode are offered as different contexts will have+different \"natural\" units, and always forcing precise parsing (which+also implies case-sensitivity) will lead to confusing user interfaces.++The internal calculations when converting values are done via the+'Rational' type (with arbitrary precision), and precision loss happens+only at the last step of converting to the target type; for+float\/doubles this is 'fromRational', for integral types this is+'round'.++A few examples are given below:++>>> showValue (Left FormatBinary) 2048+"2.0Ki"+>>> showValue (Left FormatSiAll) 0.0001+"100.0u"+>>> showValue (Right Mebi) 1048576+"1Mi"+>>> parseValue ParseExact "2.5Ki"::Either String Double+Right 2560.0+>>> parseValue ParseBinary "2M"::Either String Int+Right 2097152+>>> parseValue ParseExact "2ki"+Left "Unrecognised unit 'ki'"++The failure in the last example is due to the fact that 'ParseExact'+is case-sensitive.++-}++module Data.Prefix.Units+  (+  -- * Basic definitions+  -- ** Types+  Unit(..)+  , RationalConvertible(..)+  , siUnits+  , siSupraunitary+  , siKMGT+  , binaryUnits+  -- ** Unit-related functions+  , unitMultiplier+  , unitName+  , unitSymbol+  , fancySymbol+  -- * Formatting functions+  , FormatMode(..)+  , recommendedUnit+  , formatValue+  , showValue+  -- * Parsing functions+  , ParseMode(..)+  , parseSymbol+  , parseValue+  -- * Low-level generic functions+  , unitRange+  -- ** Parsing+  , ParseOptions(..)+  , parseExactSymbol+  , parseBinarySymbol+  , parseKMGTSymbol+  , parseGeneric+  -- ** Formatting+  , showValueWith+  ) where++import Control.Monad.Instances ()+import Data.Char (toUpper)+import Data.List (intercalate)++--import Data.Prefix.Units.Helpers++default ()++-- | The unit type.+data Unit = Yocto+          | Zepto+          | Atto+          | Femto+          | Pico+          | Nano+          | Micro+          | Milli+          | Centi+          | Deci+          | Deka+          | Hecto+          | Kilo+          | Kibi+          | Mega+          | Mebi+          | Giga+          | Gibi+          | Tera+          | Tebi+          | Peta+          | Pebi+          | Exa+          | Exbi+          | Zetta+          | Yotta+            deriving (Show, Eq, Enum, Bounded, Ord)++-- | List of all SI units.+siUnits :: [Unit]+siUnits+  = [Yocto, Zepto, Atto, Femto, Pico, Nano, Micro, Milli, Centi,+     Deci, Deka, Hecto, Kilo, Mega, Giga, Tera, Peta, Exa, Zetta, Yotta]++-- | List of binary units.+binaryUnits :: [Unit]+binaryUnits = [Kibi, Mebi, Gibi, Tebi, Pebi, Exbi]++-- | List of units which are supraunitary (their multiplier is greater+-- than one).+siSupraunitary :: [Unit]+siSupraunitary = filter (>= Deka) siUnits++-- | List of SI units which are greater or equal to 'Kilo'.+siKMGT :: [Unit]+siKMGT = filter (>= Kilo) siUnits++-- | Returns the unit scaling \"multiplier\" (which can be either+-- supra- or sub-unitary):+--+-- >>> unitMultiplier Micro+-- 1 % 1000000+-- >>> unitMultiplier Mebi+-- 1048576 % 1+unitMultiplier :: Unit -> Rational+unitMultiplier Yocto = 10.0 ^^ (-24 :: Int)+unitMultiplier Zepto = 10.0 ^^ (-21 :: Int)+unitMultiplier Atto  = 10.0 ^^ (-18 :: Int)+unitMultiplier Femto = 10.0 ^^ (-15 :: Int)+unitMultiplier Pico  = 10.0 ^^ (-12 :: Int)+unitMultiplier Nano  = 10.0 ^^ ( -9 :: Int)+unitMultiplier Micro = 10.0 ^^ ( -6 :: Int)+unitMultiplier Milli = 10.0 ^^ ( -3 :: Int)+unitMultiplier Centi = 10.0 ^^ ( -2 :: Int)+unitMultiplier Deci  = 10.0 ^^ ( -1 :: Int)+unitMultiplier Deka  = 10.0 ^^ (  1 :: Int)+unitMultiplier Hecto = 10.0 ^^ (  2 :: Int)+unitMultiplier Kilo  = 10.0 ^^ (  3 :: Int)+unitMultiplier Kibi  =  2.0 ^^ ( 10 :: Int)+unitMultiplier Mega  = 10.0 ^^ (  6 :: Int)+unitMultiplier Mebi  =  2.0 ^^ ( 20 :: Int)+unitMultiplier Giga  = 10.0 ^^ (  9 :: Int)+unitMultiplier Gibi  =  2.0 ^^ ( 30 :: Int)+unitMultiplier Tera  = 10.0 ^^ ( 12 :: Int)+unitMultiplier Tebi  =  2.0 ^^ ( 40 :: Int)+unitMultiplier Peta  = 10.0 ^^ ( 15 :: Int)+unitMultiplier Pebi  =  2.0 ^^ ( 50 :: Int)+unitMultiplier Exa   = 10.0 ^^ ( 18 :: Int)+unitMultiplier Exbi  =  2.0 ^^ ( 60 :: Int)+unitMultiplier Zetta = 10.0 ^^ ( 21 :: Int)+unitMultiplier Yotta = 10.0 ^^ ( 24 :: Int)++-- | Returns the unit full name.+unitName :: Unit -> String+unitName Yocto = "yocto"+unitName Zepto = "zepto"+unitName Atto  = "atto"+unitName Femto = "femto"+unitName Pico  = "pico"+unitName Nano  = "nano"+unitName Micro = "micro"+unitName Milli = "milli"+unitName Centi = "centi"+unitName Deci  = "deci"+unitName Deka  = "deka"+unitName Hecto = "hecto"+unitName Kilo  = "kilo"+unitName Kibi  = "kibi"+unitName Mega  = "mega"+unitName Mebi  = "mebi"+unitName Giga  = "giga"+unitName Gibi  = "gibi"+unitName Tera  = "tera"+unitName Tebi  = "tebi"+unitName Peta  = "peta"+unitName Pebi  = "pebi"+unitName Exa   = "exa"+unitName Exbi  = "exbi"+unitName Zetta = "zetta"+unitName Yotta = "yotta"++-- | Returns the unit ASCII symbol.+unitSymbol :: Unit -> String+unitSymbol Yocto = "y"+unitSymbol Zepto = "z"+unitSymbol Atto  = "a"+unitSymbol Femto = "f"+unitSymbol Pico  = "p"+unitSymbol Nano  = "n"+unitSymbol Micro = "u"+unitSymbol Milli = "m"+unitSymbol Centi = "c"+unitSymbol Deci  = "d"+unitSymbol Deka  = "da"+unitSymbol Hecto = "h"+unitSymbol Kilo  = "k"+unitSymbol Kibi  = "Ki"+unitSymbol Mega  = "M"+unitSymbol Mebi  = "Mi"+unitSymbol Giga  = "G"+unitSymbol Gibi  = "Gi"+unitSymbol Tera  = "T"+unitSymbol Tebi  = "Ti"+unitSymbol Peta  = "P"+unitSymbol Pebi  = "Pi"+unitSymbol Exa   = "E"+unitSymbol Exbi  = "Ei"+unitSymbol Zetta = "Z"+unitSymbol Yotta = "Y"++-- | Returns the unit symbol, which for the 'Micro' unit is not ASCII.+fancySymbol :: Unit -> String+fancySymbol Micro = "\xb5"+fancySymbol u = unitSymbol u++-- * RationalConvertible++-- | Typeclass for handling values that can be converted to\/from+-- 'Rational'.+class (Real a) => RationalConvertible a where+  -- | Converts the value from Ratioal+  convFromRational :: Rational -> a++instance RationalConvertible Int where+  convFromRational = round++instance RationalConvertible Integer where+  convFromRational = round++instance RationalConvertible Float where+  convFromRational = fromRational++instance RationalConvertible Double where+  convFromRational = fromRational++instance RationalConvertible Rational where+  convFromRational = id++-- | Scales a given value to be represented in the desired unit's scale.+scaleToUnit :: (RationalConvertible a) => a -> Unit -> a+scaleToUnit val = convFromRational . (rational_val /) . unitMultiplier+  where rational_val = toRational val++-- | Scales a given value to units from a given unit's scale.+scaleFromUnit :: (RationalConvertible a) => a -> Unit -> a+scaleFromUnit val = convFromRational . (rational_val *) . unitMultiplier+  where rational_val = toRational val++-- * Formatting functionality++-- | Defines the formatting modes.+data FormatMode+  = FormatSiAll          -- ^ Formats the value using any SI unit.+  | FormatSiSupraunitary -- ^ Formats the value using supraunitary SI+                         -- units only (which means that e.g. @0.001@+                         -- will remain as such instead of being+                         -- formatted as @1m@)+  | FormatSiKMGT         -- ^ Formats the value using units greater or+                         -- equal to 'Kilo'.+  | FormatBinary         -- ^ Formats the value using binary units.+    deriving (Show, Enum, Bounded)++-- | Type synonym to choose between a 'FormatMode' or a 'Unit'.+type FormatOption = Either FormatMode Unit++-- | The available units range for various format modes.+unitRange :: FormatMode -> [Unit]+unitRange FormatSiAll = siUnits+unitRange FormatSiSupraunitary = siSupraunitary+unitRange FormatSiKMGT = siKMGT+unitRange FormatBinary = binaryUnits++-- | Computes the recommended unit for displaying a given value. The+-- simple algorithm uses the first unit for which we have a+-- supraunitary representation. In case we don't find any such value+-- (e.g. for a zero value), then 'Nothing' is returned.+recommendedUnit :: (Real a) => FormatMode -> a -> Maybe Unit+recommendedUnit fmt val =+  let range = unitRange fmt+      ratv = Prelude.toRational val+  in foldr (\u a -> if ratv / unitMultiplier u >= 1 then Just u else a)+     Nothing $ reverse range++-- | Computes the scaled value and unit for a given value+formatValue :: (RationalConvertible a) =>+               FormatOption    -- ^ The desired 'FormatMode' or 'Unit'+            -> a               -- ^ The value to format+            -> (a, Maybe Unit) -- ^ Scaled value and optional unit+formatValue fmt val =+  let unit = either (flip recommendedUnit val) Just fmt+      scaled = maybe val (scaleToUnit val) unit+  in (scaled, unit)++-- | Simple helper to generate the full string representation of an+-- integral value.+showValueWith :: (RationalConvertible a, Show a) =>+                 (Unit -> String)  -- ^ Function to convert the+                                   -- (optional) unit into a+                                   -- string, e.g. 'unitSymbol' or+                                   -- 'fancySymbol'+              -> FormatOption      -- ^ The desired format mode+              -> a                 -- ^ The value to show+              -> String            -- ^ Resulting string+showValueWith symbfn fmt val =+  let (scaled, unit) = formatValue fmt val+  in show scaled ++ maybe "" symbfn unit++-- | Generates a final string representation of a value.+showValue :: (RationalConvertible a, Show a) =>+             FormatOption  -- ^ The desired format mode, either as a+                           -- 'Left' 'FormatMode' value which computes+                           -- the unit automatically, or as a 'Right'+                           -- 'Unit', which will use the specified+                           -- unit+          -> a             -- ^ The value to show+          -> String        -- ^ Resulting string+showValue = showValueWith unitSymbol++-- * Parsing functionality++-- | Error message for unknown unit.+unknownUnit :: String -> Either String Unit+unknownUnit unit = Left $ "Unrecognised unit '" ++ unit ++ "'"++-- | Parses a symbol in the exact mode. See 'ParseExact' for details.+parseExactSymbol :: String -> Either String Unit+parseExactSymbol "y" = Right Yocto+parseExactSymbol "z" = Right Zepto+parseExactSymbol "a" = Right Atto+parseExactSymbol "f" = Right Femto+parseExactSymbol "p" = Right Pico+parseExactSymbol "n" = Right Nano+parseExactSymbol "u" = Right Micro+parseExactSymbol "m" = Right Milli+parseExactSymbol "c" = Right Centi+parseExactSymbol "d" = Right Deci+parseExactSymbol "da" = Right Deka+parseExactSymbol "h" = Right Hecto+parseExactSymbol "k" = Right Kilo+parseExactSymbol "Ki" = Right Kibi+parseExactSymbol "M" = Right Mega+parseExactSymbol "Mi" = Right Mebi+parseExactSymbol "G" = Right Giga+parseExactSymbol "Gi" = Right Gibi+parseExactSymbol "T" = Right Tera+parseExactSymbol "Ti" = Right Tebi+parseExactSymbol "P" = Right Peta+parseExactSymbol "Pi" = Right Pebi+parseExactSymbol "E" = Right Exa+parseExactSymbol "Ei" = Right Exbi+parseExactSymbol "Z" = Right Zetta+parseExactSymbol "Y" = Right Yotta+parseExactSymbol unit = unknownUnit unit++-- | Helper for 'parseBinarySymbol' which only deals with upper-case+-- strings.+helperParseBinary :: String -> Either String Unit+helperParseBinary "K"  = Right Kibi+helperParseBinary "KI" = Right Kibi+helperParseBinary "M"  = Right Mebi+helperParseBinary "MI" = Right Mebi+helperParseBinary "G"  = Right Gibi+helperParseBinary "GI" = Right Gibi+helperParseBinary "T"  = Right Tebi+helperParseBinary "TI" = Right Tebi+helperParseBinary "P"  = Right Pebi+helperParseBinary "PI" = Right Pebi+helperParseBinary "E"  = Right Exbi+helperParseBinary "EI" = Right Exbi+-- FIXME: error message will contain upper-case version of the symbol+helperParseBinary symbol = unknownUnit symbol++-- | Parses a binary symbol. See 'ParseBinary' for details.+parseBinarySymbol :: String -> Either String Unit+parseBinarySymbol = helperParseBinary . upperSym++-- | Helper for 'parseKMGTSymbol' which only deals with upper-case strings.+helperParseKMGT :: String -> Either String Unit+helperParseKMGT "K"  = Right Kilo+helperParseKMGT "KI" = Right Kibi+helperParseKMGT "M"  = Right Mega+helperParseKMGT "MI" = Right Mebi+helperParseKMGT "G"  = Right Giga+helperParseKMGT "GI" = Right Gibi+helperParseKMGT "T"  = Right Tera+helperParseKMGT "TI" = Right Tebi+helperParseKMGT "P"  = Right Peta+helperParseKMGT "PI" = Right Pebi+helperParseKMGT "E"  = Right Exa+helperParseKMGT "EI" = Right Exbi+helperParseKMGT "Z"  = Right Zetta+helperParseKMGT "Y"  = Right Yotta+-- FIXME: error message will contain upper-case version of the symbol+helperParseKMGT symbol = unknownUnit symbol++-- | Parses the given symbol as one of the \"big\" units (kilo/kibi+-- and above). This allows the parsing to be case-insensitive.+parseKMGTSymbol :: String -> Either String Unit+parseKMGTSymbol = helperParseKMGT . upperSym++-- | Defines available parse modes.+data ParseMode+  = ParseExact   -- ^ Exact parser mode. This mode is fully+                 -- case-sensitive.+  | ParseKMGT    -- ^ Parses only units with bigger than 'Kilo',+                 -- respectively 'Kibi' (for binary units). This allows+                 -- the parser to be case-insensitive.+  | ParseBinary  -- ^ Parses binary units only. In this mode, both the+                 -- exact and shortened forms are accepted (e.g. both+                 -- \"k\" and \"ki\" will be converted into+                 -- 'Kibi'). Furthermore, the parsing is+                 -- case-insensitive.+    deriving (Show, Enum, Bounded)++-- | Defines unit handling mode on parse.+data ParseOptions+  = UnitRequired     -- ^ Requires that the input string+                     -- has a unit.+  | UnitDefault Unit -- ^ If unit is missing, use a+                     -- default one.+  | UnitOptional     -- ^ The unit is optional, a missing+                     -- one means the value is not+                     -- scaled.+    deriving (Show)++-- | Parses a unit from a string. The exact parsing mode determines+-- the rules for parsing and the range of possible units.+parseSymbol :: ParseMode -> String -> Either String Unit+parseSymbol ParseExact = parseExactSymbol+parseSymbol ParseKMGT = parseKMGTSymbol+parseSymbol ParseBinary = parseBinarySymbol++-- | Generic parse routine. Takes two function arguments which fix the+-- initial and final conversion, a parse mode and the string to be+-- parsed.+parseValue :: (Read a, RationalConvertible a) =>+                ParseMode       -- ^ The desired parse mode+             -> String          -- ^ String to be parsed+             -> Either String a+parseValue = parseGeneric UnitOptional []++-- | Validate a parsed unit using a given valid options list.+validUnit :: [Unit] -> Unit -> Either String Unit+validUnit [] unit = Right unit+validUnit ulist unit =+  if unit `notElem` ulist+     then Left $ "Unit '" ++ show unit ++ "' not part of the accepted" +++            " unit list (" ++ intercalate ", " (map show ulist) ++ ")"+    else Right unit++-- | Parses a string unit depending on the various options and modes.+processUnit :: ParseOptions+            -> ParseMode+            -> [Unit]+            -> String+            -> Maybe (Either String Unit)+processUnit popts pmode valid_units unit_suffix =+  if null unit_suffix+    then case popts of+           UnitRequired -> Just $ Left "An unit is required but the\+                                       \ input string lacks one"+           UnitDefault def_unit -> Just $ Right def_unit+           UnitOptional -> Nothing+    else Just $+         -- this is because older GHC versions don't have the "Either+         -- String a" monad instance+         either Left (validUnit valid_units) (parseSymbol pmode unit_suffix)++-- | Generic parse routine. Takes two function arguments which fix the+-- initial and final conversion, a parse mode and the string to be+-- parsed.+parseGeneric :: (Read a, RationalConvertible a) =>+                ParseOptions    -- ^ Unit options+             -> [Unit]          -- ^ Optional list of valid units+             -> ParseMode       -- ^ The desired parse mode+             -> String          -- ^ String to be parsed+             -> Either String a+parseGeneric popts valid_units pmode str =+  case reads str of+    [(v, suffix)] ->+      let unit_suffix = dropWhile (== ' ') suffix+          unit = processUnit popts pmode valid_units unit_suffix+      in maybe (Right v) (fmap (scaleFromUnit v)) unit+    _ -> Left $ "Can't parse string '" ++ str ++ "'"++-- | Converts a string to upper-case.+upperSym :: String -> String+upperSym = map toUpper

@@ -0,0 +1,28 @@+Copyright 2012, Google Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.+    * 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.+    * Neither the name of Google Inc. 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+OWNER 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.

@@ -0,0 +1,26 @@+CABAL_OPTS = --hyperlink-source++build:+	cabal build++int-docs:+	cabal haddock \+	  $(CABAL_OPTS) \+	  --internal++haddock:+	cabal haddock \+	  $(CABAL_OPTS)++configure:+	cabal clean+	cabal configure --enable-tests --enable-library-coverage++test:+	cabal build+	cabal test++dist:+	cabal sdist++.PHONY: build int-docs haddock configure test dist

@@ -0,0 +1,42 @@+prefix-units package+====================++This package defines a datatype (`Unit`) and associated+parsing/formatting functions so that command line applications can+handle "nice" values like:++    $ cmd create-file foo 100G+    Done.+    $ cmd ls-file foo+    Size is 100Gi+    $ cmd ls-files+    foo 100Gi+    bar  14Ki++And so on. For details on the API, look at the Haddock documentation+for the `Data.Prefix.Units` module.++For building and installing, `cabal configure` and related commands+are enough. Run `cabal configure --enable-tests && cabal build &&+cabal test` if you want to run the unit-tests.++TODO+----++The current interface of the library works, but is not nicely+composable. I'm still looking for a nicer way to expose the parsing+functionality.++Currently, the binary and SI units are mixed in the same+data-type. This works, but at some level I think two separate types+would be more "correct", at the expense of a more complex API.++The RationalConvertible type class has only a few instances; ideally+we'd have `instance Integral a => RationalConvertible a` and similar+for `Fractional`, but this doesn't work as such in Haskell, so we're+stuck with the manual derivation.++The current behaviour is case-sensitive for all units in `ParseExact`+mode, which means that one has to use (in this mode) `Ki` for the+binary unit `Kibi`. This seems suboptimal, since the binary units are+unique irrespective of casing.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,98 @@+-- prefix-units.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                prefix-units++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1.0++-- A short (one-line) description of the package.+Synopsis:            A basic library for SI/binary prefix units++-- A longer description of the package.+Description:+  This library deals with parsing values containing \"prefix units\"+  (both binary and SI). For example, it can parse 10M and 1G, and it+  can also format values for displaying with the \"optimal\" unit.++  For more details, see the man page units(7),+  <http://physics.nist.gov/cuu/Units/prefixes.html> and+  <http://physics.nist.gov/cuu/Units/binary.html>.++-- URL for the project homepage or repository.+Homepage:            http://code.google.com/p/prefix-units/++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Iustin Pop <iustin@google.com>++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          Iustin Pop <iustin@google.com>++-- A copyright notice.+Copyright:           (c) 2012 Google Inc.++Category:            Data++-- Stability field.+Stability:           alpha++Bug-reports:         https://code.google.com/p/prefix-units/issues/++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files:  README.md CHANGES Makefile++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >= 1.8.0.2++Tested-with:         GHC==6.12.1, GHC==7.4.1++Source-repository head+  Type:             git+  Location:         https://code.google.com/p/prefix-units/++Source-repository this+  Type:             git+  Location:         https://code.google.com/p/prefix-units/+  Tag:              prefix-units-v0.1.0++Library+  -- Modules exported by the library.+  Exposed-modules: Data.Prefix.Units++  -- Packages needed in order to build this package.+  Build-depends:  base >= 3 && < 5++  -- Modules not exported by this package.+  Other-modules:++  GHC-Options:    -Wall++  Extensions:     Safe TypeSynonymInstances FlexibleInstances++  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:++Test-Suite test-units+  type:              exitcode-stdio-1.0+  hs-source-dirs:    tests+  main-is:           Properties.hs+  build-depends:     base  >= 3 && < 5+                   , Cabal >= 1.9.2+                   , test-framework >= 0.6 && < 0.7+                   , test-framework-quickcheck2 >= 0.2.12 && < 0.3+                   , QuickCheck >= 2.4.2 && < 2.5+                   , prefix-units+  ghc-options:       -Wall -fno-warn-orphans

@@ -0,0 +1,350 @@+{-++Copyright 2012, Google Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.+    * 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.+    * Neither the name of Google Inc. 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+OWNER 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.++-}++{- | Tests for the Data.Prefix.Units module++-}++module Main (main) where++import Data.Char (toUpper)+import Data.List+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck++import Data.Prefix.Units++-- * Test helpers++failTest :: String -> Property+failTest msg = printTestCase msg False++-- | Checks for equality with proper annotation.+(==?) :: (Show a, Eq a) => a -> a -> Property+(==?) x y = printTestCase+            ("Expected equality, but '" +++             show x ++ "' /= '" ++ show y ++ "'") (x == y)+infix 3 ==?++-- | Formats a failed-to-parse-unit message.+failParseUnit :: Unit -> String -> Property+failParseUnit unit err =+  failTest $ "Failed to parse unit '" ++ unitName unit ++ "': " ++ err++-- | Fails unless we received an error message that passes a given+-- condition.+expectParseFailure :: (Show a) =>+                      (String -> Bool)+                   -> Either String a+                   -> Property+expectParseFailure fn (Left err) =+  printTestCase "Unexpected error message" $ fn err+expectParseFailure _  (Right v)  =+  failTest $ "Unexpected parse with result " ++ show v++-- | Expect a parse result to be a given value.+expectParse :: (Real a, Real b) => a -> Unit -> Either String b -> Property+expectParse _ unit (Left err) = failParseUnit unit err+expectParse v unit (Right v') =+  printTestCase "Parsed wrong value: " $+  toRational v' ==? toRational v * unitMultiplier unit++-- * Instances++instance Arbitrary Unit where+  arbitrary = elements [minBound..maxBound]++instance Arbitrary FormatMode where+  arbitrary = elements [minBound..maxBound]++instance Arbitrary ParseMode where+  arbitrary = elements [minBound..maxBound]++allUnits :: [Unit]+allUnits = [minBound..maxBound]++-- * Actual tests++-- ** Definitions++testUniqueNames :: Property+testUniqueNames =+  let names = map unitName allUnits+  in names ==? nub names++testUniqueSymbols :: Property+testUniqueSymbols =+  let symbols = map unitSymbol allUnits+  in symbols ==? nub symbols++testUniqueFancySymbols :: Property+testUniqueFancySymbols =+  let symbols = map fancySymbol allUnits+  in symbols ==? nub symbols++testOrdering :: Property+testOrdering =+  let si_mult = map unitMultiplier $ sort siUnits+      bin_mult = map unitMultiplier $ sort binaryUnits+      all_mult = map unitMultiplier allUnits -- no sorting here!+  in si_mult ==? sort si_mult .&&.+     bin_mult ==? sort bin_mult .&&.+     all_mult ==? sort all_mult++testSIBinary :: Property+testSIBinary =+  printTestCase "SI unit lists contain binary prefixes" $+                (null (siUnits `intersect` binaryUnits)) .&&.+                (null (siKMGT `intersect` binaryUnits)) .&&.+                (null (siSupraunitary `intersect` binaryUnits))++-- ** Parsing++testNullUnitInt :: Int -> ParseMode -> Property+testNullUnitInt v pmode =+  case parseValue pmode (show v) of+    Left err -> failTest $ "Failed to parse empty unit: " ++ err+    Right v' -> printTestCase "Parsed wrong value:" (v ==? v')++testNullUnitFrac :: Double -> ParseMode -> Property+testNullUnitFrac d pmode =+  case parseValue pmode (show d) of+    Left err -> failTest $ "Failed to parse empty unit: " ++ err+    Right d' -> printTestCase "Parsed wrong value:" (d ==? d')++testSymbolParsingExact :: Unit -> Property+testSymbolParsingExact unit =+  case parseExactSymbol (unitSymbol unit) of+    Left err -> failParseUnit unit err+    Right unit' -> printTestCase "Parsed wrong unit: " (unit ==? unit')++-- | Binary units should parse themselves in explicit binary mode.+testSymbolParsingBinary :: Property+testSymbolParsingBinary =+  forAll (elements binaryUnits) $ \unit ->+  case parseBinarySymbol (unitSymbol unit) of+    Left err -> failParseUnit unit err+    Right unit' -> printTestCase "Parsed wrong unit: " (unit ==? unit')++-- | Binary units should parse themselves in all parsing modes.+testSymbolParsingBinaryAbbrev :: Property+testSymbolParsingBinaryAbbrev =+  forAll (elements binaryUnits) $ \unit ->+  case parseSymbol ParseBinary (take 1 (unitSymbol unit)) of+    Left err -> failParseUnit unit err+    Right unit' -> printTestCase "Parsed wrong unit: " (unit ==? unit')++-- | Binary units should parse themselves in all parsing modes.+testSymbolParsingBinaryAll :: ParseMode -> Property+testSymbolParsingBinaryAll mode =+  forAll (elements binaryUnits) $ \unit ->+  case parseSymbol mode (unitSymbol unit) of+    Left err -> failParseUnit unit err+    Right unit' -> printTestCase "Parsed wrong unit: " (unit ==? unit')++-- | Fail to parse invalid symbols in any mode.+testSymbolParsingFail :: ParseMode -> Property+testSymbolParsingFail mode =+  expectParseFailure (("NO-SUCH" `isInfixOf`) . map toUpper) $+    parseSymbol mode ("no-such")++-- | Parsed values should be correct.+testParsingIntKMGT :: Int -> Property+testParsingIntKMGT v =+  forAll (elements (siKMGT ++ binaryUnits)) $ \unit ->+  let str = show v ++ unitSymbol unit in+  expectParse v unit (parseValue ParseKMGT str::Either String Integer)++-- | Parsed values should be correct.+testParsingInt :: Int -> Property+testParsingInt v =+  forAll (elements (siSupraunitary ++ binaryUnits)) $ \unit ->+  let str = show v ++ unitSymbol unit in+  expectParse v unit (parseValue ParseExact str::Either String Integer)++-- | Parsed values should be correct.+--+-- Note that this tests floating point number equality, so it could be+-- flaky.+testParsingDouble :: Unit -> Double -> Property+testParsingDouble unit d =+  let str = show d ++ unitSymbol unit in+  case (parseValue ParseExact str)::Either String Double of+    Left err -> failParseUnit unit err+    Right d' -> printTestCase ("Parsing of " ++ str ++ " failed: ") $+                d' ==? fromRational (toRational d * unitMultiplier unit)++-- | Parsed values should be correct.+testParsingRational :: Unit -> Integer -> Property+testParsingRational unit v =+  let str = show v ++ "%1" ++ unitSymbol unit in+  expectParse v unit (parseValue ParseExact str::Either String Rational)++testFailParsing :: ParseMode -> Int -> Property+testFailParsing pmode v =+  expectParseFailure ("no-such" `isInfixOf`)+    (parseValue pmode ("no-such" ++ show v)::Either String Int)++-- | Test fail parse on required unit.+testParsingRequired :: ParseMode -> Int -> Property+testParsingRequired pmode v =+  expectParseFailure ("is required" `isInfixOf`)+    (parseGeneric UnitRequired [] pmode (show v)::Either String Int)++testParsingDefault :: Unit -> ParseMode -> Rational -> Property+testParsingDefault unit pmode v =+  expectParse v unit+    (parseGeneric (UnitDefault unit) [] pmode (show v)::Either String Rational)++testParsingInvalidList :: Unit -> [Unit] -> Int -> Property+testParsingInvalidList unit valid v =+  unit `notElem` valid && not (null valid) ==>+  expectParseFailure ("not part of the accepted unit list" `isInfixOf`)+    (parseGeneric UnitOptional valid ParseExact+       (show v ++ unitSymbol unit)::Either String Int)++testParsingValidList :: Unit -> [Unit] -> Rational -> Property+testParsingValidList unit valid v =+  unit `elem` valid && not (null valid) ==>+  expectParse v unit+   (parseGeneric UnitOptional valid ParseExact+      (show v ++ unitSymbol unit)::Either String Rational)++-- ** Formatting++testTrivialFormattingRec :: FormatMode -> Property+testTrivialFormattingRec fmt =+  recommendedUnit fmt (0::Int) ==? Nothing .&&.+  recommendedUnit fmt (0::Double) ==? Nothing++testTrivialFormattingFmt :: FormatMode -> Property+testTrivialFormattingFmt fmt =+  formatValue (Left fmt) (0::Int) ==? (0, Nothing) .&&.+  formatValue (Left fmt) (0::Double) ==? (0, Nothing)++testTrivialFormattingShow :: FormatMode -> Property+testTrivialFormattingShow fmt =+  showValue (Left fmt) (0::Int) ==? "0" .&&.+  showValue (Left fmt) (0::Double) ==? show (0::Double)++testRecommend :: Property+testRecommend =+  forAll (elements [FormatSiAll, FormatBinary]) $ \fmt ->+  forAll (elements (unitRange fmt)) $ \unit ->+  case recommendedUnit fmt (unitMultiplier unit) of+    Nothing -> failTest $ "Expected recommendation of unit " +++               unitName unit ++ " but got nothing"+    Just unit' -> printTestCase "Mismatch in recommended unit: " $+                  unit ==? unit'++testForceUnit :: Unit -> Rational -> Property+testForceUnit unit v =+  case formatValue (Right unit) v of+    (v', Just u') -> printTestCase "Invalid value/unit computed" $+                     unit ==? u' .&&.+                     v ==? v' * unitMultiplier unit+    x -> failTest $ "Invalid result from formatValue: " ++ show x++testFormatIntegral :: Property+testFormatIntegral =+  forAll (elements [FormatSiSupraunitary, FormatBinary]) $ \fmt ->+  forAll (elements (unitRange fmt)) $ \unit ->+  let fmted = formatValue (Left fmt) . truncate . unitMultiplier $ unit+  in fmted ==? (1::Integer, Just unit)++testFormatFractional :: Property+testFormatFractional =+  forAll (elements [FormatSiSupraunitary, FormatBinary]) $ \fmt ->+  forAll (elements (unitRange fmt)) $ \unit ->+  let fmted = formatValue (Left fmt) . unitMultiplier $ unit+  in fmted ==? (1::Rational, Just unit)++testShowIntegralBinary :: Property+testShowIntegralBinary =+  forAll (elements binaryUnits) $ \ unit ->+  let value = truncate (unitMultiplier unit)::Integer in+  printTestCase ("Formatting/showing unit " ++ show unit) $+   showValue (Left FormatBinary) value ==? "1" ++ unitSymbol unit++testShowRational :: Unit -> Property+testShowRational unit =+  let fmtmode = if unit `elem` binaryUnits then FormatBinary else FormatSiAll+      value = unitMultiplier unit+  in printTestCase ("Formatting/showing unit " ++ show unit) $+     showValue (Left fmtmode) value ==? "1 % 1" ++ unitSymbol unit++-- * Test harness++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests =+  [ testGroup "definitions"+    [ testProperty "unique names" testUniqueNames+    , testProperty "unique symbols" testUniqueSymbols+    , testProperty "unique fancy symbols" testUniqueFancySymbols+    , testProperty "ordering" testOrdering+    , testProperty "type mixup" testSIBinary+    ]+  , testGroup "parsing"+    [ testProperty "null unit integral" testNullUnitInt+    , testProperty "null unit fractional" testNullUnitFrac+    , testProperty "symbol parsing/exact" testSymbolParsingExact+    , testProperty "symbol parsing/binary" testSymbolParsingBinary+    , testProperty "symbol parsing/binary-all" testSymbolParsingBinaryAll+    , testProperty "symbol parsing/binary-abbrev" testSymbolParsingBinaryAbbrev+    , testProperty "symbol parsing/failure" testSymbolParsingFail+    , testProperty "parsing/integral-kmgt" testParsingIntKMGT+    , testProperty "parsing/integral" testParsingInt+    , testProperty "parsing/fractional" testParsingDouble+    , testProperty "parsing/rational" testParsingRational+    , testProperty "parsing/failure" testFailParsing+    , testProperty "parsing/required unit" testParsingRequired+    , testProperty "parsing/default" testParsingDefault+    , testProperty "parsing/invalid-list" testParsingInvalidList+    , testProperty "parsing/valid-list" testParsingValidList+    ]+  , testGroup "formatting"+    [ testProperty "trivial formatting/recommend" testTrivialFormattingRec+    , testProperty "trivial formatting/fmt" testTrivialFormattingFmt+    , testProperty "trivial formatting/show" testTrivialFormattingShow+    , testProperty "recommend" testRecommend+    , testProperty "force unit" testForceUnit+    , testProperty "format/int" testFormatIntegral+    , testProperty "format/frac" testFormatFractional+    , testProperty "show/integral binary" testShowIntegralBinary+    , testProperty "show/rational" testShowRational+    ]+  ]