Make fromText of Float more accurate, relax accuracy for Float and Double tests

This commit is contained in:
Christian Marie 2015-03-17 12:08:47 +11:00
parent 3311cbd901
commit 47a30c6411
2 changed files with 14 additions and 3 deletions

View File

@ -11,6 +11,7 @@ import Data.String.Conversions (cs)
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Read (Reader, decimal, rational, signed) import Data.Text.Read (Reader, decimal, rational, signed)
import Data.Word (Word, Word16, Word32, Word64, Word8) import Data.Word (Word, Word16, Word32, Word64, Word8)
import GHC.Float (double2Float)
-- | For getting values from url captures and query string parameters -- | For getting values from url captures and query string parameters
-- Instances should obey: -- Instances should obey:
@ -130,7 +131,9 @@ instance ToText Double where
toText = cs . show toText = cs . show
instance FromText Float where instance FromText Float where
fromText = runReader rational -- Double is more practically accurate due to weird rounding when using
-- rational. We convert to double and then convert to Float.
fromText = fmap double2Float . runReader rational
instance ToText Float where instance ToText Float where
toText = cs . show toText = cs . show

View File

@ -55,11 +55,19 @@ spec = describe "Servant.Common.Text" $ do
it "holds for Integer" $ it "holds for Integer" $
property $ \x -> textLaw (x :: Integer) property $ \x -> textLaw (x :: Integer)
-- The following two properties are only reasonably expected to hold up
-- to a certain precision.
--
-- http://en.wikipedia.org/wiki/Floating_point#Internal_representation
it "holds for Double" $ it "holds for Double" $
property $ \x -> textLaw (x :: Double) property $ \x ->
x < 1.0e15 && x > 1.0e-16 ==>
textLaw (x :: Double)
it "holds for Float" $ it "holds for Float" $
property $ \x -> textLaw (x :: Float) property $ \x ->
x < 1.0e7 && x > 1.0e-7 ==>
textLaw (x :: Float)
textLaw :: (FromText a, ToText a, Eq a) => a -> Bool textLaw :: (FromText a, ToText a, Eq a) => a -> Bool
textLaw a = fromText (toText a) == Just a textLaw a = fromText (toText a) == Just a