git.iko.soy/typeable/servant
on master help sign in
Make full-precision FromText for Float and Double
commit2931d2e119a75632cf932874531445d59ee0c4b1 authorJulian K. Arni <jkarni@gmail.com> dateTue 24 Mar 2015, 14:53 (12 years ago) parent24e32f1
2 files changed+5−9
src/Servant/Common/Text.hs+3−3 test/Servant/Common/TextSpec.hs+2−6
src/Servant/Common/Text.hs+3−3
@@ -6,12 +6,12 @@ module Servant.Common.Text
66 , ToText(..)
77 ) where
88
9+import Control.Applicative ((<$>))
910import Data.Int (Int16, Int32, Int64, Int8)
1011import Data.String.Conversions (cs)
1112import Data.Text (Text)
1213import Data.Text.Read (Reader, decimal, rational, signed)
1314import Data.Word (Word, Word16, Word32, Word64, Word8)
14−import GHC.Float (double2Float)
1515
1616-- | For getting values from url captures and query string parameters
1717-- Instances should obey:
@@ -125,7 +125,7 @@ instance ToText Integer where
125125 toText = cs . show
126126
127127instance FromText Double where
128− fromText = runReader rational
128+ fromText x = fromRational <$> runReader rational x
129129
130130instance ToText Double where
131131 toText = cs . show
@@ -133,7 +133,7 @@ instance ToText Double where
133133instance FromText Float where
134134 -- Double is more practically accurate due to weird rounding when using
135135 -- rational. We convert to double and then convert to Float.
136− fromText = fmap double2Float . runReader rational
136+ fromText x = fromRational <$> runReader rational x
137137
138138instance ToText Float where
139139 toText = cs . show
test/Servant/Common/TextSpec.hs+2−6
@@ -60,14 +60,10 @@ spec = describe "Servant.Common.Text" $ do
6060 --
6161 -- http://en.wikipedia.org/wiki/Floating_point#Internal_representation
6262 it "holds for Double" $
63− property $ \x ->
64− x < 1.0e15 && x > 1.0e-15 ==>
65− textLaw (x :: Double)
63+ property $ \x -> textLaw (x :: Double)
6664
6765 it "holds for Float" $
68− property $ \x ->
69− x < 1.0e7 && x > 1.0e-7 ==>
70− textLaw (x :: Float)
66+ property $ \x -> textLaw (x :: Float)
7167
7268textLaw :: (FromText a, ToText a, Eq a) => a -> Bool
7369textLaw a = fromText (toText a) == Just a