Merge #907

907: Fix `FromText` instance for `Double` (and `FeePolicy`). r=jonathanknowles a=jonathanknowles

# Issue Number

None. Discovered while testing PR #889.

# Overview

This PR:

- [x] Changes the implementation of `FromText` for `Double` to use `read @Double` rather than `Data.Text.Read.rational`. This matches the `ToText` implementation, which just uses `show`.
- [x] Simplifies the roundtrip textual encoding test for `Double`.
- [x] Simplifies the roundtrip textual encoding test for `FeePolicy`.

# Explanation

The implementations of `show` and `read` for `Double` are expected to obey the following property:

```
read . show = id
```

The implementation of `Data.Text.Read.rational`, on the other hand, differs slightly from that of `read @Double`. This difference occasionally introduces small errors across roundtrip serialization & deserialization.

For example:

```hs
> a = -9.0e-3 :: Double
> a
-9.0e-3
> read @double (show a)
-9.0e-3
> rational @double (pack $ show a)
Right (-9.000000000000001e-3,"")
```

Co-authored-by: Jonathan Knowles <[email protected]>

lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs

@@ -110,7 +110,7 @@ import Data.Set
 import Data.Text
     ( Text )
 import Data.Text.Class
-    ( TextDecodingError (..), fromText, toText )
+    ( TextDecodingError (..), fromText )
 import Data.Time
     ( UTCTime )
 import Data.Time.Utils
@@ -164,26 +164,13 @@ spec = do
         textRoundtrip $ Proxy @Address
         textRoundtrip $ Proxy @AddressState
         textRoundtrip $ Proxy @Direction
+        textRoundtrip $ Proxy @FeePolicy
         textRoundtrip $ Proxy @TxStatus
         textRoundtrip $ Proxy @WalletName
         textRoundtrip $ Proxy @WalletId
         textRoundtrip $ Proxy @(Hash "Genesis")
         textRoundtrip $ Proxy @(Hash "Tx")
 
-        it "FeePolicy" $ property $ withMaxSuccess 10000 $
-            \fp@(LinearFee (Quantity a) (Quantity b)) ->
-                -- We have to be a little careful here, as small errors can
-                -- occur when encoding and decoding floating point numbers to
-                -- and from text. Rather than requiring absolute equality, we
-                -- instead require that the decoded values are close enough to
-                -- the original values, allowing for a small margin of error.
-                let Right (LinearFee (Quantity a') (Quantity b')) =
-                        fromText (toText fp) in
-                let epsilon = 1e-6 in
-                (abs (a - a') `shouldSatisfy` (< epsilon))
-                    .&&.
-                    (abs (b - b') `shouldSatisfy` (< epsilon))
-
     describe "Buildable" $ do
         it "WalletId" $ do
             let seed = Passphrase (BA.convert @ByteString "0000000000000000")

lib/text-class/src/Data/Text/Class.hs

@@ -45,13 +45,15 @@ import Data.Maybe
 import Data.Text
     ( Text )
 import Data.Text.Read
-    ( decimal, rational, signed )
+    ( decimal, signed )
 import Fmt
     ( Buildable )
 import GHC.Generics
     ( Generic )
 import Numeric.Natural
     ( Natural )
+import Text.Read
+    ( readEither )
 
 import qualified Data.Char as C
 import qualified Data.Text as T
@@ -124,10 +126,7 @@ instance ToText Integer where
     toText = T.pack . show
 
 instance FromText Double where
-    fromText t = do
-        (parsedValue, unconsumedInput) <- first (const err) $ rational t
-        unless (T.null unconsumedInput) $ Left err
-        pure parsedValue
+    fromText = first (const err) . readEither . T.unpack
       where
         err = TextDecodingError "Expecting floating number"
 

lib/text-class/test/unit/Data/Text/ClassSpec.hs

@@ -97,19 +97,11 @@ spec = do
         it "fromText . toText == pure" $ property $ \(x :: Natural) ->
             (fromText . toText) x === pure x
 
-    describe "Rational" $ do
+    describe "Double" $ do
         it "fromText \"patate\"" $
             let err = "Expecting floating number"
             in fromText @Double "patate" === Left (TextDecodingError err)
 
-        it "fromText . toText == pure" $ property $ \(x :: Rational) ->
-            let
-                d = fromRational x
-                eps = 1e6 :: Double
-            in case fromText (toText d) of
-                Left _ -> False
-                Right d' -> abs (d - d') < eps
-
     describe "Text" $ do
         it "fromText \"patate\"" $
             fromText @Text "patate" === pure "patate"
@@ -120,6 +112,7 @@ spec = do
 
     describe "Can perform roundtrip textual encoding & decoding" $ do
         textRoundtrip $ Proxy @String
+        textRoundtrip $ Proxy @Double
 
     describe "BoundedEnum" $ do
         it "fromTextToBoundedEnum s (toTextFromBoundedEnum s a) == Right a" $