prefix-units 0.1.0.2 → 0.3.0.1
raw patch · 8 files changed
Files
- CHANGES.md +46/−3
- Data/Prefix/Units.hs +191/−131
- Data/Prefix/Units/Compat.hs +51/−0
- Makefile +3/−1
- README.md +4/−1
- example.hs +23/−0
- prefix-units.cabal +49/−31
- tests/Properties.hs +151/−36
CHANGES.md view
@@ -1,16 +1,59 @@-Version 0.1.0.2+## Version 0.3.0.1 +*released Thu, 27 Apr 2023*++It turns out that even if `cabal check` shows no warnings, Hackage+doesn't accept packages with very old cabal version constraints. So+this release bumps that, which in turns makes `cabal check` actually+start to show warnings, so modernise the cabal file as a result.++There are no code changes compared to 0.3.0, so this is a no-op+release from the point of view of functionality.++## Version 0.3.0++*released Wed, 26 Apr 2023*++* Add the new quecto/ronto/ronna/quetta units. I didn't think I'd ever+ have to extend the list of units! Not sure entirely if these should+ be part of the parseKMGT function, since they're high enough to be+ out of normal computer units, but they do have lower/upper versions,+ so adding them seems the right thing.++## Version 0.2.0++*released Sun, 22 Nov 2015*++* Incompatible API change to cleanup some initial design decisions:+ the two level `FormatOption`/`FormatMode` model is removed, the+ fixed unit of `FormatOption` is moved to a new constructor+ `FormatMode`, and `FormatOption` is removed entirely. This should be+ a simpler API, at the cost of breaking compatibility.+* Fixed issue #3 (No support for negative numbers).+* Worked around issue #1 (Add 'base' unit) by adding a mode that+ disables scaling; it should have the same effect without introducing+ an artificial unit.++## Version 0.1.0.2++*released Sun, 23 Nov 2014*+ * Trivial release for compatibility with QuickCheck 2.7 and older HUnit packages as found in Wheezy. * The release switches the test suite to use Cabal macros, which might create issues in some cases.+* Fixed issue #2 (Wrong formatting for small numbers in SI mode). -Version 0.1.0.1+## Version 0.1.0.1 +*released Mon, 19 May 2014*+ * Trivial release updating upper package bounds (for testing), updating homepage/related settings as part of move to github, and fixing a few documentation issues. -Version 0.1.0+## Version 0.1.0++*released Thu, 03 May 2012* * Initial release.
Data/Prefix/Units.hs view
@@ -1,6 +1,6 @@ {- -Copyright 2012, 2014, Google Inc.+Copyright 2012, 2014, 2015, Google Inc. All rights reserved. Redistribution and use in source and binary forms, with or without@@ -66,11 +66,11 @@ A few examples are given below: ->>> showValue (Left FormatBinary) 2048+>>> showValue FormatBinary 2048 "2.0Ki"->>> showValue (Left FormatSiAll) 0.0001+>>> showValue FormatSiAll 0.0001 "100.0u"->>> showValue (Right Mebi) 1048576+>>> showValue (FormatFixed Mebi) 1048576 "1Mi" >>> parseValue ParseExact "2.5Ki"::Either String Double Right 2560.0@@ -94,6 +94,8 @@ , siSupraunitary , siKMGT , binaryUnits+ , siBase+ , binaryBase -- ** Unit-related functions , unitMultiplier , unitName@@ -120,16 +122,18 @@ , showValueWith ) where -import Control.Monad.Instances ()+import Control.Monad (liftM) import Data.Char (toUpper) import Data.List (intercalate) ---import Data.Prefix.Units.Helpers+import Data.Prefix.Units.Compat () default () -- | The unit type.-data Unit = Yocto+data Unit = Quecto+ | Ronto+ | Yocto | Zepto | Atto | Femto@@ -155,13 +159,38 @@ | Exbi | Zetta | Yotta+ | Ronna+ | Quetta 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]+ = [ Quecto+ , Ronto+ , Yocto+ , Zepto+ , Atto+ , Femto+ , Pico+ , Nano+ , Micro+ , Milli+ , Centi+ , Deci+ , Deka+ , Hecto+ , Kilo+ , Mega+ , Giga+ , Tera+ , Peta+ , Exa+ , Zetta+ , Yotta+ , Ronna+ , Quetta+ ] -- | List of binary units. binaryUnits :: [Unit]@@ -176,6 +205,14 @@ siKMGT :: [Unit] siKMGT = filter (>= Kilo) siUnits +-- | The base for SI units.+siBase :: Rational+siBase = 10++-- | The base for binary units.+binaryBase :: Rational+binaryBase = 2+ -- | Returns the unit scaling \"multiplier\" (which can be either -- supra- or sub-unitary): --@@ -184,90 +221,102 @@ -- >>> 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)+unitMultiplier Quecto = siBase ^^ (-30 :: Int)+unitMultiplier Ronto = siBase ^^ (-27 :: Int)+unitMultiplier Yocto = siBase ^^ (-24 :: Int)+unitMultiplier Zepto = siBase ^^ (-21 :: Int)+unitMultiplier Atto = siBase ^^ (-18 :: Int)+unitMultiplier Femto = siBase ^^ (-15 :: Int)+unitMultiplier Pico = siBase ^^ (-12 :: Int)+unitMultiplier Nano = siBase ^^ ( -9 :: Int)+unitMultiplier Micro = siBase ^^ ( -6 :: Int)+unitMultiplier Milli = siBase ^^ ( -3 :: Int)+unitMultiplier Centi = siBase ^^ ( -2 :: Int)+unitMultiplier Deci = siBase ^^ ( -1 :: Int)+unitMultiplier Deka = siBase ^^ ( 1 :: Int)+unitMultiplier Hecto = siBase ^^ ( 2 :: Int)+unitMultiplier Kilo = siBase ^^ ( 3 :: Int)+unitMultiplier Kibi = binaryBase ^^ ( 10 :: Int)+unitMultiplier Mega = siBase ^^ ( 6 :: Int)+unitMultiplier Mebi = binaryBase ^^ ( 20 :: Int)+unitMultiplier Giga = siBase ^^ ( 9 :: Int)+unitMultiplier Gibi = binaryBase ^^ ( 30 :: Int)+unitMultiplier Tera = siBase ^^ ( 12 :: Int)+unitMultiplier Tebi = binaryBase ^^ ( 40 :: Int)+unitMultiplier Peta = siBase ^^ ( 15 :: Int)+unitMultiplier Pebi = binaryBase ^^ ( 50 :: Int)+unitMultiplier Exa = siBase ^^ ( 18 :: Int)+unitMultiplier Exbi = binaryBase ^^ ( 60 :: Int)+unitMultiplier Zetta = siBase ^^ ( 21 :: Int)+unitMultiplier Yotta = siBase ^^ ( 24 :: Int)+unitMultiplier Ronna = siBase ^^ ( 27 :: Int)+unitMultiplier Quetta = siBase ^^ ( 30 :: 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"+unitName Quecto = "quecto"+unitName Ronto = "ronto"+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"+unitName Ronna = "ronna"+unitName Quetta = "quetta" -- | 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"+unitSymbol Quecto = "q"+unitSymbol Ronto = "r"+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"+unitSymbol Ronna = "R"+unitSymbol Quetta = "Q" -- | Returns the unit symbol, which for the 'Micro' unit is not ASCII. fancySymbol :: Unit -> String@@ -315,47 +364,61 @@ | 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@)+ -- 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+ | FormatUnscaled -- ^ Formats the value as it is, without+ -- scaling.+ | FormatFixed Unit -- ^ Formats the value using the given unit.+ deriving (Show) -- | The available units range for various format modes.-unitRange :: FormatMode -> [Unit]-unitRange FormatSiAll = siUnits-unitRange FormatSiSupraunitary = siSupraunitary-unitRange FormatSiKMGT = siKMGT-unitRange FormatBinary = binaryUnits+unitRange :: FormatMode -> Either Unit [Unit]+unitRange FormatSiAll = Right siUnits+unitRange FormatSiSupraunitary = Right siSupraunitary+unitRange FormatSiKMGT = Right siKMGT+unitRange FormatBinary = Right binaryUnits+unitRange FormatUnscaled = Right []+unitRange (FormatFixed u) = Left u +-- | Whether a given value should be scaled (in auto-scaling modes) or+-- not.+shouldScale :: (Num a, Ord a) => a -> Bool+-- FIXME: this is not nice at all: we hardcode the set [1, 10) instead+-- of having it naturally follow from a base unit or similar.+shouldScale val = val < 1 || val >= 10+ -- | 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.+-- (e.g. for a zero value), then 'Nothing' is returned. For+-- `FormatFixed`, we always select the given unit, irrespective of the+-- value. recommendedUnit :: (Real a) => FormatMode -> a -> Maybe Unit-recommendedUnit fmt val- -- FIXME: this is not nice at all: we hardcode the set [1, 10)- -- instead of having it naturally follow from a base unit or- -- similar.- | val >= 1 && val < 10 = Nothing- | otherwise =- 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+recommendedUnit fmt val =+ case unitRange fmt of+ Left u -> Just u+ Right range ->+ if shouldScale val+ then foldr (\u a -> if ratv / unitMultiplier u >= 1 then Just u else a)+ Nothing $ reverse range+ else Nothing+ where ratv = Prelude.toRational val -- | Computes the scaled value and unit for a given value formatValue :: (RationalConvertible a) =>- FormatOption -- ^ The desired 'FormatMode' or 'Unit'+ FormatMode -- ^ The desired 'FormatMode' -> a -- ^ The value to format -> (a, Maybe Unit) -- ^ Scaled value and optional unit formatValue fmt val =- let unit = either (`recommendedUnit` val) Just fmt- scaled = maybe val (scaleToUnit val) unit- in (scaled, unit)+ let inverter = if val < 0+ then negate+ else id+ val' = inverter val+ unit = recommendedUnit fmt val'+ scaled = maybe val' (scaleToUnit val') unit+ in (inverter scaled, unit) -- | Simple helper to generate the full string representation of an -- integral value.@@ -364,7 +427,7 @@ -- (optional) unit into a -- string, e.g. 'unitSymbol' or -- 'fancySymbol'- -> FormatOption -- ^ The desired format mode+ -> FormatMode -- ^ The desired format mode -> a -- ^ The value to show -> String -- ^ Resulting string showValueWith symbfn fmt val =@@ -373,11 +436,7 @@ -- | 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+ FormatMode -- ^ The desired format mode. -> a -- ^ The value to show -> String -- ^ Resulting string showValue = showValueWith unitSymbol@@ -390,6 +449,8 @@ -- | Parses a symbol in the exact mode. See 'ParseExact' for details. parseExactSymbol :: String -> Either String Unit+parseExactSymbol "q" = Right Quecto+parseExactSymbol "r" = Right Ronto parseExactSymbol "y" = Right Yocto parseExactSymbol "z" = Right Zepto parseExactSymbol "a" = Right Atto@@ -416,6 +477,8 @@ parseExactSymbol "Ei" = Right Exbi parseExactSymbol "Z" = Right Zetta parseExactSymbol "Y" = Right Yotta+parseExactSymbol "R" = Right Ronna+parseExactSymbol "Q" = Right Quetta parseExactSymbol unit = unknownUnit unit -- | Helper for 'parseBinarySymbol' which only deals with upper-case@@ -456,6 +519,8 @@ helperParseKMGT "EI" = Right Exbi helperParseKMGT "Z" = Right Zetta helperParseKMGT "Y" = Right Yotta+helperParseKMGT "R" = Right Ronna+helperParseKMGT "Q" = Right Quetta -- FIXME: error message will contain upper-case version of the symbol helperParseKMGT symbol = unknownUnit symbol @@ -518,18 +583,13 @@ -> 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)+ -> Either String (Maybe Unit)+processUnit UnitRequired _ _ "" =+ Left "An unit is required but the input string lacks one"+processUnit (UnitDefault u) _ _ "" = Right $ Just u+processUnit UnitOptional _ _ "" = Right Nothing+processUnit _ pmode valid_units unit_suffix =+ liftM Just (parseSymbol pmode unit_suffix >>= validUnit valid_units) -- | Low-level parse routine. Takes two function arguments which fix -- the initial and final conversion, a parse mode and the string to be@@ -545,7 +605,7 @@ [(v, suffix)] -> let unit_suffix = dropWhile (== ' ') suffix unit = processUnit popts pmode valid_units unit_suffix- in maybe (Right v) (fmap (scaleFromUnit v)) unit+ in maybe v (scaleFromUnit v) `fmap` unit _ -> Left $ "Can't parse string '" ++ str ++ "'" -- | Converts a string to upper-case.
+ Data/Prefix/Units/Compat.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-++Copyright 2015, 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 for compatibility across various GHC versions -}++module Data.Prefix.Units.Compat+ where++#if !MIN_VERSION_base(4,6,0)+import Control.Monad.Instances ()+#endif++#if !MIN_VERSION_base(4,3,0)+instance Monad (Either a) where+ return = Right+ Left l >>= _ = Left l+ Right r >>= f = f r+#endif
Makefile view
@@ -25,7 +25,9 @@ lint: @rm -f report.html- hlint --cpp-define='MIN_VERSION_QuickCheck(a,b,c)=1' \+ hlint \+ --cpp-define='MIN_VERSION_QuickCheck(a,b,c)=1' \+ --cpp-define='MIN_VERSION_base(a,b,c)=1' \ --report -c Data tests clean:
README.md view
@@ -25,6 +25,9 @@ the use of some hand-coded conversions instead of using TemplateHaskell to generate them automatically. +[](https://github.com/iustin/prefix-units/actions/workflows/ci.yml)+[](https://codecov.io/gh/iustin/prefix-units)+ TODO ---- @@ -32,7 +35,7 @@ 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+Currently, the IEC (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.
+ example.hs view
@@ -0,0 +1,23 @@+module Main where++import Data.Prefix.Units++showValueAs :: Double -> FormatMode -> IO ()+showValueAs val mode = do+ putStrLn $ "Formatting " ++ show val ++ " in mode " ++ show mode +++ " is: " ++ showValue mode val++main = do+ putStr $ "Enter a value (with optional units; case sensitive!): "+ in_str <- getLine+ case parseValue ParseExact in_str of+ Left err -> putStrLn $ "Error parsing the value: " ++ err+ Right v -> do+ putStrLn $ "You entered " ++ show v+ mapM_ (showValueAs v) [ FormatSiAll+ , FormatSiSupraunitary+ , FormatSiKMGT+ , FormatBinary+ , FormatUnscaled+ ]+ mapM_ (showValueAs v . FormatFixed) [minBound..maxBound]
prefix-units.cabal view
@@ -1,87 +1,100 @@+cabal-version: 1.18 -- 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+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.2+version: 0.3.0.1 -- A short (one-line) description of the package.-Synopsis: A basic library for SI/binary prefix units+synopsis: A basic library for SI/IEC prefix units -- A longer description of the package.-Description:+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.+ (both IEC\/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: https://github.com/iustin/prefix-units+homepage: https://github.com/iustin/prefix-units -- The license under which the package is released.-License: BSD3+license: BSD3 -- The file containing the license text.-License-file: LICENSE+license-file: LICENSE -- The package author(s).-Author: Iustin Pop <iustin@google.com>+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>+maintainer: Iustin Pop <iustin@google.com> -- A copyright notice.-Copyright: (c) 2012, 2014 Google Inc.+copyright: (c) 2012, 2014, 2015 Google Inc. -Category: Data+category: Data -- Stability field.-Stability: alpha+stability: stable -Bug-reports: https://github.com/iustin/prefix-units/issues+bug-reports: https://github.com/iustin/prefix-units/issues -Build-type: Simple+build-type: Simple -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files: README.md CHANGES.md Makefile---- Constraint on the version of Cabal needed to build this package.-Cabal-version: >= 1.8.0.2+extra-source-files: README.md CHANGES.md Makefile example.hs -Tested-with: GHC==6.12.1, GHC==7.4.1, GHC==7.6.3+tested-with: GHC==8.0.2+ , GHC==8.2.2+ , GHC==8.4+ , GHC==8.6+ , GHC==8.8+ , GHC==8.10+ , GHC==9.0+ , GHC==9.2+ , GHC==9.4+ , GHC==9.6 -Source-repository head+source-repository head Type: git Location: https://github.com/iustin/prefix-units.git -Source-repository this+source-repository this Type: git Location: https://github.com/iustin/prefix-units.git- Tag: prefix-units-v0.1.0.1+ Tag: prefix-units-v0.2.0 -Library+library -- Modules exported by the library.- Exposed-modules: Data.Prefix.Units+ exposed-modules: Data.Prefix.Units -- Packages needed in order to build this package.- Build-depends: base >= 3 && < 5+ build-depends: base >= 3 && < 5 -- Modules not exported by this package.- Other-modules:+ other-modules: Data.Prefix.Units.Compat - GHC-Options: -Wall+ ghc-options: -Wall - Extensions: Safe TypeSynonymInstances FlexibleInstances+ default-language: Haskell2010 + default-extensions:+ Safe+ TypeSynonymInstances+ FlexibleInstances+ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: @@ -96,6 +109,11 @@ , test-framework-hunit >= 0.2.7 , QuickCheck >= 2.4.2 , HUnit >= 1.2.4+ , deepseq >= 1.4.0.0 , prefix-units ghc-options: -Wall -fno-warn-orphans- Extensions: CPP+ default-extensions:+ CPP+ ScopedTypeVariables++ default-language: Haskell2010
tests/Properties.hs view
@@ -39,6 +39,8 @@ module Main (main) where +import Control.Applicative (pure, (<$>))+import Control.DeepSeq (force) import Data.Char (toUpper) import Data.List import Data.Maybe (isNothing)@@ -92,17 +94,44 @@ counterexample "Parsed wrong value: " $ toRational v' ==? toRational v * unitMultiplier unit +-- | Generates an auto-scale 'FormatMode'.+genAutoMode :: Gen FormatMode+genAutoMode = elements [ FormatSiAll+ , FormatSiSupraunitary+ , FormatSiKMGT+ , FormatBinary+ ]+++-- | Helper to check that unitRange retuns a Right [Unit], as expected+-- (as we pass only auto-format modes).+checkedUnitRange :: FormatMode -> [Unit]+checkedUnitRange =+ either (error "unitRange returned 'Left Unit'?!") id . unitRange+ -- * Instances instance Arbitrary Unit where arbitrary = elements [minBound..maxBound] instance Arbitrary FormatMode where- arbitrary = elements [minBound..maxBound]+ arbitrary = oneof [ pure FormatSiAll+ , pure FormatSiSupraunitary+ , pure FormatSiKMGT+ , pure FormatBinary+ , pure FormatUnscaled+ , FormatFixed <$> arbitrary+ ] instance Arbitrary ParseMode where arbitrary = elements [minBound..maxBound] +instance Arbitrary ParseOptions where+ arbitrary = oneof [ pure UnitRequired+ , UnitDefault <$> arbitrary+ , pure UnitOptional+ ]+ allUnits :: [Unit] allUnits = [minBound..maxBound] @@ -127,13 +156,17 @@ testOrdering :: Assertion testOrdering = do- let si_mult = map unitMultiplier $ sort siUnits- bin_mult = map unitMultiplier $ sort binaryUnits- all_mult = map unitMultiplier allUnits -- no sorting here!+ let si_mult = map unitMultiplier siUnits+ bin_mult = map unitMultiplier binaryUnits+ all_mult = map unitMultiplier allUnits sort si_mult @=? si_mult sort bin_mult @=? bin_mult sort all_mult @=? all_mult +testOrderingProp :: Unit -> Unit -> Property+testOrderingProp u1 u2 =+ compare u1 u2 ==? compare (unitMultiplier u1) (unitMultiplier u2)+ testSIBinary :: Assertion testSIBinary = assertBool "SI unit lists contain binary prefixes" $@@ -141,6 +174,13 @@ null (siKMGT `intersect` binaryUnits) && null (siSupraunitary `intersect` binaryUnits) +testSISmallMultipliers :: Assertion+testSISmallMultipliers = do+ let baseExp = siBase ^^ (3::Int)+ mapM_ (\unit -> assertEqual ("For unit " ++ unitName unit ++ ": ")+ (baseExp * unitMultiplier (pred unit)) (unitMultiplier unit))+ $ tail (filter (<= Milli) siUnits)+ -- ** Parsing testNullUnitInt :: Int -> ParseMode -> Property@@ -188,7 +228,7 @@ -- | Fail to parse invalid symbols in any mode. testSymbolParsingFail :: ParseMode -> Property testSymbolParsingFail mode =- expectParseFailure (("NO-SUCH" `isInfixOf`) . map toUpper) $+ expectParseFailure (("NO-SUCH" `isInfixOf`) . force . map toUpper) $ parseSymbol mode "no-such" -- | Parsed values should be correct.@@ -198,26 +238,38 @@ let str = show v ++ unitSymbol unit in expectParse v unit (parseValue ParseKMGT str::Either String Integer) --- | Parsed values should be correct.+-- | Parsed integer 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 =+-- | Polymorphic helper for checking parsing.+parsingHelper :: forall a. (Show a, Read a,+ RationalConvertible a, Fractional a) =>+ Unit -> a -> Property+parsingHelper unit d = let str = show d ++ unitSymbol unit in- case parseValue ParseExact str::Either String Double of+ case parseValue ParseExact str::Either String a of Left err -> failParseUnit unit err Right d' -> counterexample ("Parsing of " ++ str ++ " failed: ") $ d' ==? fromRational (toRational d * unitMultiplier unit) --- | Parsed values should be correct.+-- | Parsed float values should be correct.+--+-- Note that this tests floating point number equality, so it could be+-- flaky, especially as float has lower resolution than double.+testParsingFloat :: Unit -> Float -> Property+testParsingFloat = parsingHelper++-- | Parsed double values should be correct.+--+-- Also potentially flaky.+testParsingDouble :: Unit -> Double -> Property+testParsingDouble = parsingHelper++-- | Parsed rational values should be correct. testParsingRational :: Unit -> Integer -> Property testParsingRational unit v = let str = show v ++ "%1" ++ unitSymbol unit in@@ -225,13 +277,13 @@ testFailParsing :: ParseMode -> Int -> Property testFailParsing pmode v =- expectParseFailure ("no-such" `isInfixOf`)+ expectParseFailure (("no-such" `isInfixOf`) . force) (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`)+ expectParseFailure (("is required" `isInfixOf`) . force) (parseGeneric UnitRequired [] pmode (show v)::Either String Int) testParsingDefault :: Unit -> ParseMode -> Rational -> Property@@ -242,7 +294,7 @@ testParsingInvalidList :: Unit -> [Unit] -> Int -> Property testParsingInvalidList unit valid v = unit `notElem` valid && not (null valid) ==>- expectParseFailure ("not part of the accepted unit list" `isInfixOf`)+ expectParseFailure (("not part of the accepted unit list" `isInfixOf`) . force) (parseGeneric UnitOptional valid ParseExact (show v ++ unitSymbol unit)::Either String Int) @@ -253,27 +305,42 @@ (parseGeneric UnitOptional valid ParseExact (show v ++ unitSymbol unit)::Either String Rational) +testParsingNegativePositive :: Unit -> Positive Int -> Property+testParsingNegativePositive unit (Positive val) =+ let pos = show val ++ unitSymbol unit+ neg = show (negate val) ++ unitSymbol unit+ in case (parseValue ParseExact pos::Either String Int,+ parseValue ParseExact neg::Either String Int) of+ (_, Left err) ->+ failParseUnit unit err+ (Left err, _) ->+ failParseUnit unit err+ (Right vpos, Right vneg) -> vpos ==? negate vneg+ -- ** Formatting -testTrivialFormattingRec :: FormatMode -> Property-testTrivialFormattingRec fmt =+testTrivialFormattingRec :: Property+testTrivialFormattingRec =+ forAll genAutoMode $ \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)+testTrivialFormattingFmt :: Property+testTrivialFormattingFmt =+ forAll genAutoMode $ \fmt ->+ formatValue fmt (0::Int) ==? (0, Nothing) .&&.+ formatValue fmt (0::Double) ==? (0, Nothing) -testTrivialFormattingShow :: FormatMode -> Property-testTrivialFormattingShow fmt =- showValue (Left fmt) (0::Int) ==? "0" .&&.- showValue (Left fmt) (0::Double) ==? show (0::Double)+testTrivialFormattingShow :: Property+testTrivialFormattingShow =+ forAll genAutoMode $ \fmt ->+ showValue fmt (0::Int) ==? "0" .&&.+ showValue fmt (0::Double) ==? show (0::Double) testRecommend :: Property testRecommend = forAll (elements [FormatSiAll, FormatBinary]) $ \fmt ->- forAll (elements (unitRange fmt)) $ \unit ->+ forAll (elements (checkedUnitRange fmt)) $ \unit -> let value = unitMultiplier unit in case recommendedUnit fmt value of Nothing -> failTest $ "Expected recommendation of unit " ++@@ -292,24 +359,38 @@ testForceUnit :: Unit -> Rational -> Property testForceUnit unit v =- case formatValue (Right unit) v of+ case formatValue (FormatFixed unit) v of (v', Just u') -> counterexample "Invalid value/unit computed" $ unit ==? u' .&&. v ==? v' * unitMultiplier unit x -> failTest $ "Invalid result from formatValue: " ++ show x +testForceNoUnit :: Rational -> Property+testForceNoUnit v =+ case formatValue FormatUnscaled v of+ (v', Nothing) -> counterexample "Invalid value computed" $+ v ==? v'+ (_, Just u) -> failTest ("Formatted using unit '" ++ show u +++ "' when no unit expected")+ testFormatIntegral :: Property testFormatIntegral = forAll (elements [FormatSiSupraunitary, FormatBinary]) $ \fmt ->- forAll (elements (unitRange fmt)) $ \unit ->- let fmted = formatValue (Left fmt) . truncate . unitMultiplier $ unit+ forAll (elements (checkedUnitRange fmt)) $ \unit ->+ let fmted = formatValue fmt . truncate . unitMultiplier $ unit in fmted ==? (1::Integer, Just unit) +testFormatNegativePositive :: Positive Int -> FormatMode -> Property+testFormatNegativePositive (Positive i) mode =+ let (pscaled, punit) = formatValue mode i+ (nscaled, nunit) = formatValue mode (negate i)+ in (pscaled, punit) ==? (negate nscaled, nunit)+ testFormatFractional :: Property testFormatFractional = forAll (elements [FormatSiSupraunitary, FormatBinary]) $ \fmt ->- forAll (elements (unitRange fmt)) $ \unit ->- let fmted = formatValue (Left fmt) . unitMultiplier $ unit+ forAll (elements (checkedUnitRange fmt)) $ \unit ->+ let fmted = formatValue fmt . unitMultiplier $ unit in fmted ==? (1::Rational, Just unit) testShowIntegralBinary :: Property@@ -317,15 +398,37 @@ forAll (elements binaryUnits) $ \ unit -> let value = truncate (unitMultiplier unit)::Integer in counterexample ("Formatting/showing unit " ++ show unit) $- showValue (Left FormatBinary) value ==? '1' : unitSymbol unit+ showValue FormatBinary value ==? '1' : unitSymbol unit testShowRational :: Unit -> Property testShowRational unit = let fmtmode = if unit `elem` binaryUnits then FormatBinary else FormatSiAll value = unitMultiplier unit in counterexample ("Formatting/showing unit " ++ show unit) $- showValue (Left fmtmode) value ==? "1 % 1" ++ unitSymbol unit+ showValue fmtmode value ==? "1 % 1" ++ unitSymbol unit +-- ** Round-trip tests++testRoundTripRational :: Rational -> FormatMode -> Property+testRoundTripRational val mode =+ let fmted = showValue mode val in+ case parseValue ParseExact fmted of+ Left err -> failTest ("Failed to parse formatted strint '" ++ fmted +++ "': " ++ err)+ Right val' -> val ==? val'++-- | Trivial assertion that the Show instance works+testFormatModeShow :: FormatMode -> Property+testFormatModeShow = total . show++-- | Trivial assertion that the Show instance works+testParseModeShow :: ParseMode -> Property+testParseModeShow = total . show++-- | Trivial assertion that the Show instance works+testParseOptionsShow :: ParseOptions -> Property+testParseOptionsShow = total . show+ -- * Test harness main :: IO ()@@ -338,7 +441,9 @@ , testCase "unique symbols" testUniqueSymbols , testCase "unique fancy symbols" testUniqueFancySymbols , testCase "ordering" testOrdering+ , testProperty "ordering/prop" testOrderingProp , testCase "type mixup" testSIBinary+ , testCase "SI small multipliers" testSISmallMultipliers ] , testGroup "parsing" [ testProperty "null unit integral" testNullUnitInt@@ -350,24 +455,34 @@ , testProperty "symbol parsing/failure" testSymbolParsingFail , testProperty "parsing/integral-kmgt" testParsingIntKMGT , testProperty "parsing/integral" testParsingInt- , testProperty "parsing/fractional" testParsingDouble+ , testProperty "parsing/fractional-float" testParsingFloat+ , testProperty "parsing/fractional-double" 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+ , testProperty "parsing negativ/positive" testParsingNegativePositive ] , testGroup "formatting" [ testProperty "trivial formatting/recommend" testTrivialFormattingRec , testProperty "trivial formatting/fmt" testTrivialFormattingFmt , testProperty "trivial formatting/show" testTrivialFormattingShow+ , testProperty "negative/positive equivalence" testFormatNegativePositive , testProperty "recommend" testRecommend , testProperty "recommend small units" testRecommendSmall , testProperty "force unit" testForceUnit+ , testProperty "force no unit" testForceNoUnit , testProperty "format/int" testFormatIntegral , testProperty "format/frac" testFormatFractional , testProperty "show/integral binary" testShowIntegralBinary , testProperty "show/rational" testShowRational+ ]+ , testGroup "round-trip"+ [ testProperty "rational round-trip" testRoundTripRational+ , testProperty "format mode show" testFormatModeShow+ , testProperty "parse mode show" testParseModeShow+ , testProperty "parse options show" testParseOptionsShow ] ]