eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Make full-precision FromText for Float and Double

Browse source
This commit is contained in:
Julian K. Arni 2015-03-24 14:53:39 +01:00
parent 24e32f194e
commit 2931d2e119
2 changed files with 5 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/Servant/Common/Text.hs
View file

@ -6,12 +6,12 @@ module Servant.Common.Text
, ToText(..) , ToText(..)
) where ) where
import Control.Applicative ((<$>))
import Data.Int (Int16, Int32, Int64, Int8) import Data.Int (Int16, Int32, Int64, Int8)
import Data.String.Conversions (cs) 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:
@ -125,7 +125,7 @@ instance ToText Integer where
toText = cs . show toText = cs . show
instance FromText Double where instance FromText Double where
fromText = runReader rational fromText x = fromRational <$> runReader rational x
instance ToText Double where instance ToText Double where
toText = cs . show toText = cs . show
@ -133,7 +133,7 @@ instance ToText Double where
instance FromText Float where instance FromText Float where
-- Double is more practically accurate due to weird rounding when using -- Double is more practically accurate due to weird rounding when using
-- rational. We convert to double and then convert to Float. -- rational. We convert to double and then convert to Float.
fromText = fmap double2Float . runReader rational fromText x = fromRational <$> runReader rational x
instance ToText Float where instance ToText Float where
toText = cs . show toText = cs . show

8
test/Servant/Common/TextSpec.hs
View file

@ -60,14 +60,10 @@ spec = describe "Servant.Common.Text" $ do
-- --
-- http://en.wikipedia.org/wiki/Floating_point#Internal_representation -- http://en.wikipedia.org/wiki/Floating_point#Internal_representation
it "holds for Double" $ it "holds for Double" $
property $ \x -> property $ \x -> textLaw (x :: Double)
x < 1.0e15 && x > 1.0e-15 ==>
textLaw (x :: Double)
it "holds for Float" $ it "holds for Float" $
property $ \x -> property $ \x -> textLaw (x :: Float)
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