Add benchmarks and property test for double Parser

test/Streamly/Test/Unicode/Parser.hs

@@ -4,17 +4,81 @@ module Streamly.Test.Unicode.Parser
     (main)
 where
 
-import Streamly.Internal.Data.Parser (ParseError (..))
-import Test.Hspec.QuickCheck (prop)
-import Test.QuickCheck (Property)
-import Test.QuickCheck.Monadic (run, monadicIO, assert)
-
-import qualified Streamly.Data.Stream as Stream
-    ( fromList, parse )
-import qualified Streamly.Internal.Data.Stream as Stream (parseBreak, toList)
-import qualified Streamly.Unicode.Parser as Unicode
-import qualified Test.Hspec as H
+import Control.Monad.Identity (Identity(runIdentity))
 import Debug.Trace (trace)
+import Streamly.Internal.Data.Parser (ParseError (..))
+import Streamly.Test.Common (chooseDouble)
+import Test.Hspec.QuickCheck (prop)
+import Test.QuickCheck
+       (forAll, Property, property)
+import Test.QuickCheck.Monadic (monadicIO, assert, run)
+
+import qualified Data.Scientific as Scientific
+import qualified Streamly.Data.Stream as Stream
+import qualified Streamly.Internal.Data.Stream as Stream (parseBreak)
+import qualified Streamly.Unicode.Parser as Unicode
+import qualified Streamly.Internal.Unicode.Parser as Parser
+import qualified Test.Hspec as H
+
+-- Scientific notation
+scientificExpFP :: Property
+scientificExpFP =
+    forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls ->
+        case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of
+                Right val -> if val == show ls
+                             then property (val == show ls)
+                             else trace
+                                    ("Expected = " ++ show ls ++ " Got = " ++ val)
+                                    property (val == show ls)
+                Left _ -> property False
+
+        where
+
+        formatter = Scientific.formatScientific Scientific.Exponent Nothing
+        toScientific (c, m) = Scientific.scientific c m
+        parser = formatter . toScientific <$> Parser.number
+
+-- Standard decimal notation.
+scientificFixFP :: Property
+scientificFixFP =
+    forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->
+        case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of
+                Right val -> if val == show ls
+                             then property (val == show ls)
+                             else trace
+                                    ("Expected = " ++ show ls ++ " Got = " ++ val)
+                                    property (val == show ls)
+                Left _ -> property False
+
+        where
+
+        formatter = Scientific.formatScientific Scientific.Fixed Nothing
+        toScientific (c, m) = Scientific.scientific c m
+        parser = formatter . toScientific <$> Parser.number
+
+doubleExpFP :: Property
+doubleExpFP =
+    forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls -> do
+        let sls = show ls
+        case runIdentity $ Stream.parse Parser.double (Stream.fromList sls) of
+                Right val -> if val == ls
+                             then property (val == ls)
+                             else trace
+                                    ("Read = "++ show (read sls :: Double) ++ " Expected = " ++ sls ++ " Got = " ++ show val)
+                                    property (val == ls)
+                Left _ -> property False
+
+-- Standard decimal notation.
+doubleFixFP :: Property
+doubleFixFP =
+    forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->
+        case runIdentity $ Stream.parse Parser.double (Stream.fromList (show ls)) of
+                Right val -> if val == ls
+                            then property (val == ls)
+                            else trace
+                                    ("Expected = " ++ show ls ++ " Got = " ++ show val)
+                                    property (val == ls)
+                Left _ -> property False
 
 doubleParser :: String -> IO (Either ParseError Double)
 doubleParser = Stream.parse Unicode.double . Stream.fromList
@@ -23,15 +87,19 @@ double :: String -> Double -> Property
 double s d = monadicIO $ do
     x <- run $ doubleParser s
     case x of
-        Right val -> trace ("parsed " ++ show val) (assert (val == d))
-        Left (ParseError _) -> assert (False)
+        Right val -> if val == d
+                     then assert (val == d)
+                     else trace ("Expectedc = " ++ show d ++ " Got = "++ show val) (assert (val == d))
+        Left (ParseError _) -> assert False
 
 doubleErr :: String -> String -> Property
 doubleErr s msg = monadicIO $ do
     x <- run $ doubleParser s
     case x of
-        Right _ -> assert (False)
-        Left (ParseError err) -> trace err (assert (err == msg))
+        Right _ -> assert False
+        Left (ParseError err) -> if err == msg
+                                then assert (err == msg)
+                                else trace err (assert (err == msg))
 
 remainingStream :: String -> [String]
 remainingStream x =
@@ -118,3 +186,9 @@ main = do
         prop "afterParse \"..\" \"..\"" $ afterParse ".." ".."
         prop "afterParse \"+\" \"+\"" $ afterParse "+" "+"
         prop "afterParse \"++\" \"++\"" $ afterParse "++" "++"
+    H.describe "Scientific parser property test" $ do
+        prop "Exponent format" scientificExpFP
+        prop "Decimal format" scientificFixFP
+    H.describe "double parser property test" $ do
+        prop "Exponent format" doubleExpFP
+        prop "Decimal format" doubleFixFP

test/lib/Streamly/Test/Common.hs

@@ -12,6 +12,7 @@ module Streamly.Test.Common
     , listEquals
     , checkListEqual
     , chooseInt
+    , chooseDouble
     ) where
 
 import Control.Monad (when)
@@ -60,3 +61,6 @@ checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)
 
 chooseInt :: (Int, Int) -> Gen Int
 chooseInt = choose
+
+chooseDouble :: (Double, Double) -> Gen Double
+chooseDouble = choose

test/streamly-tests.cabal

@@ -158,6 +158,7 @@ common test-dependencies
       , filepath          >= 1.4.1 && < 1.5
       , temporary         >= 1.3   && < 1.4
       , network           >= 3.1   && < 3.2
+      , scientific        >= 0.0   && < 0.4
 
   if !flag(use-streamly-core)
     build-depends: streamly