From 95b7d5e0657f04b71d6880fb03e8e44919a8667d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Thu, 8 Aug 2019 13:55:23 -0400
Subject: [PATCH] Add another Scientific generator and test with it.

---
 test/Data/Scientific/Spec.hs | 15 ++++++++-------
 test/Generators.hs           | 11 +++++++++++
 2 files changed, 19 insertions(+), 7 deletions(-)

diff --git a/test/Data/Scientific/Spec.hs b/test/Data/Scientific/Spec.hs
index 0e5df6c09..f0f13722d 100644
--- a/test/Data/Scientific/Spec.hs
+++ b/test/Data/Scientific/Spec.hs
@@ -57,13 +57,14 @@ testTree = testGroup "Data.Scientific.Exts"
   , testCase "Pathological input" $ do
       isLeft (parseScientific ".") @? "Accepted period"
       isLeft (parseScientific "")  @? "Accepted empty string"
-  , testProperty "Scientific roundtripping" $ property $ do
+  , testProperty "Scientific roundtripping" . property $ do
       let nrange = Range.linear (negate 500000) 20000000
           drange = Range.exponential 1 100000000
-      sci <- forAll (Gen.rationalScientific nrange drange)
-      classify "negative" $ sci < 0
-      classify "small" $ (sci > 0 && sci <= 1)
-      classify "medium" $ (sci > 1 && sci <= 10000)
-      classify "large" $ sci > 10000
-      tripping sci (pack . show) parseScientific
+      fromRat <- forAll (Gen.rationalScientific nrange drange)
+      Gen.classifyScientific fromRat
+      tripping fromRat (pack . show) parseScientific
+  , testProperty "Double-based Scientific roundtripping" . property $ do
+      fromDbl <- forAll (Gen.floatingScientific (Range.linearFrac (negate 1) 3))
+      Gen.classifyScientific fromDbl
+      tripping fromDbl (pack . show) parseScientific
   ]
diff --git a/test/Generators.hs b/test/Generators.hs
index 762ed8af9..5b9148b70 100644
--- a/test/Generators.hs
+++ b/test/Generators.hs
@@ -3,6 +3,8 @@ module Generators
   ( source
   , integerScientific
   , rationalScientific
+  , floatingScientific
+  , classifyScientific
   ) where
 
 import Hedgehog
@@ -32,3 +34,12 @@ rationalScientific nrange drange = do
     Left (sci, _)  -> pure sci
     Right (sci, _) -> pure sci
 
+floatingScientific :: MonadGen m => Hedgehog.Range Double -> m Scientific
+floatingScientific = fmap Scientific.fromFloatDigits . Gen.double
+
+classifyScientific :: MonadTest m => Scientific -> m ()
+classifyScientific sci = do
+  classify "negative" $ sci < 0
+  classify "small" $ (sci > 0 && sci <= 1)
+  classify "medium" $ (sci > 1 && sci <= 10000)
+  classify "large" $ sci > 10000