prefix-units 0.1.0.2 → 0.2.0

raw patch · 7 files changed

+316/−116 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.md +13/−0
• Data/Prefix/Units.hs +91/−76
• Data/Prefix/Units/Compat.hs +51/−0
• Makefile +3/−1
• example.hs +23/−0
• prefix-units.cabal +10/−7
• tests/Properties.hs +125/−32

@@ -1,9 +1,22 @@+Version 0.2.0++* 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  * 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 

@@ -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,11 +122,11 @@   , 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 () @@ -176,6 +178,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,32 +194,32 @@ -- >>> 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 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)  -- | Returns the unit full name. unitName :: Unit -> String@@ -315,47 +325,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 +388,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 +397,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@@ -518,18 +538,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 +560,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.

@@ -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

@@ -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:

@@ -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]

@@ -7,7 +7,7 @@ -- 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.2.0  -- A short (one-line) description of the package. Synopsis:            A basic library for SI/binary prefix units@@ -39,7 +39,7 @@ Maintainer:          Iustin Pop <iustin@google.com>  -- A copyright notice.-Copyright:           (c) 2012, 2014 Google Inc.+Copyright:           (c) 2012, 2014, 2015 Google Inc.  Category:            Data @@ -52,12 +52,12 @@  -- Extra files to be distributed with the package, such as examples or -- a README.-Extra-source-files:  README.md CHANGES.md Makefile+Extra-source-files:  README.md CHANGES.md Makefile example.hs  -- 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, GHC==7.6.3+Tested-with:         GHC==7.6.3, GHC==7.8.4, GHC==7.10.2  Source-repository head   Type:             git@@ -66,7 +66,7 @@ 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   -- Modules exported by the library.@@ -76,11 +76,13 @@   Build-depends:  base >= 3 && < 5    -- Modules not exported by this package.-  Other-modules:+  Other-modules:  Data.Prefix.Units.Compat    GHC-Options:    -Wall -  Extensions:     Safe TypeSynonymInstances FlexibleInstances+  Extensions:     Safe+                  TypeSynonymInstances+                  FlexibleInstances    -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.   -- Build-tools:@@ -99,3 +101,4 @@                    , prefix-units   ghc-options:       -Wall -fno-warn-orphans   Extensions:      CPP+                   ScopedTypeVariables

@@ -39,6 +39,7 @@  module Main (main) where +import Control.Applicative (pure, (<$>)) import Data.Char (toUpper) import Data.List import Data.Maybe (isNothing)@@ -92,13 +93,34 @@   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]@@ -127,13 +149,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 +167,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@@ -198,26 +231,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@@ -253,27 +298,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 +352,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 +391,25 @@   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'+ -- * Test harness  main :: IO ()@@ -338,7 +422,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 +436,31 @@     , 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     ]   ]