From 2931d2e119a75632cf932874531445d59ee0c4b1 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Tue, 24 Mar 2015 14:53:39 +0100
Subject: [PATCH] Make full-precision FromText for Float and Double

---
 src/Servant/Common/Text.hs      | 6 +++---
 test/Servant/Common/TextSpec.hs | 8 ++------
 2 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/src/Servant/Common/Text.hs b/src/Servant/Common/Text.hs
index 0d2697d4..f8c4e26e 100644
--- a/src/Servant/Common/Text.hs
+++ b/src/Servant/Common/Text.hs
@@ -6,12 +6,12 @@ module Servant.Common.Text
   , ToText(..)
   ) where
 
+import           Control.Applicative     ((<$>))
 import           Data.Int                (Int16, Int32, Int64, Int8)
 import           Data.String.Conversions (cs)
 import           Data.Text               (Text)
 import           Data.Text.Read          (Reader, decimal, rational, signed)
 import           Data.Word               (Word, Word16, Word32, Word64, Word8)
-import           GHC.Float               (double2Float)
 
 -- | For getting values from url captures and query string parameters
 -- Instances should obey:
@@ -125,7 +125,7 @@ instance ToText Integer where
   toText = cs . show
 
 instance FromText Double where
-  fromText = runReader rational
+  fromText x = fromRational <$> runReader rational x
 
 instance ToText Double where
   toText = cs . show
@@ -133,7 +133,7 @@ instance ToText Double where
 instance FromText Float where
   -- 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
+  fromText x = fromRational <$> runReader rational x
 
 instance ToText Float where
   toText = cs . show
diff --git a/test/Servant/Common/TextSpec.hs b/test/Servant/Common/TextSpec.hs
index c1af6efd..7612d12c 100644
--- a/test/Servant/Common/TextSpec.hs
+++ b/test/Servant/Common/TextSpec.hs
@@ -60,14 +60,10 @@ spec = describe "Servant.Common.Text" $ do
         --
         -- http://en.wikipedia.org/wiki/Floating_point#Internal_representation
         it "holds for Double" $
-            property $ \x ->
-                x < 1.0e15 && x > 1.0e-15 ==>
-                    textLaw (x :: Double)
+            property $ \x -> textLaw (x :: Double)
 
         it "holds for Float" $
-            property $ \x ->
-                x < 1.0e7 && x > 1.0e-7 ==>
-                    textLaw (x :: Float)
+            property $ \x -> textLaw (x :: Float)
 
 textLaw :: (FromText a, ToText a, Eq a) => a -> Bool
 textLaw a = fromText (toText a) == Just a