@@ -4,17 +4,81 @@ module Streamly.Test.Unicode.Parser
44 (main)
55where
66
7+import Control.Monad.Identity (Identity(runIdentity))
8+import Debug.Trace (trace)
79import Streamly.Internal.Data.Parser (ParseError (..))
10+import Streamly.Test.Common (chooseDouble)
811import Test.Hspec.QuickCheck (prop)
9−import Test.QuickCheck (Property)
10−import Test.QuickCheck.Monadic (run, monadicIO, assert)
12+import Test.QuickCheck
13+ (forAll, Property, property)
14+import Test.QuickCheck.Monadic (monadicIO, assert, run)
1115
16+import qualified Data.Scientific as Scientific
1217import qualified Streamly.Data.Stream as Stream
13− ( fromList, parse )
14−import qualified Streamly.Internal.Data.Stream as Stream (parseBreak, toList)
18+import qualified Streamly.Internal.Data.Stream as Stream (parseBreak)
1519import qualified Streamly.Unicode.Parser as Unicode
20+import qualified Streamly.Internal.Unicode.Parser as Parser
1621import qualified Test.Hspec as H
17−import Debug.Trace (trace)
22+
23+-- Scientific notation
24+scientificExpFP :: Property
25+scientificExpFP =
26+ forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls ->
27+ case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of
28+ Right val -> if val == show ls
29+ then property (val == show ls)
30+ else trace
31+ ("Expected = " ++ show ls ++ " Got = " ++ val)
32+ property (val == show ls)
33+ Left _ -> property False
34+
35+ where
36+
37+ formatter = Scientific.formatScientific Scientific.Exponent Nothing
38+ toScientific (c, m) = Scientific.scientific c m
39+ parser = formatter . toScientific <$> Parser.number
40+
41+-- Standard decimal notation.
42+scientificFixFP :: Property
43+scientificFixFP =
44+ forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->
45+ case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of
46+ Right val -> if val == show ls
47+ then property (val == show ls)
48+ else trace
49+ ("Expected = " ++ show ls ++ " Got = " ++ val)
50+ property (val == show ls)
51+ Left _ -> property False
52+
53+ where
54+
55+ formatter = Scientific.formatScientific Scientific.Fixed Nothing
56+ toScientific (c, m) = Scientific.scientific c m
57+ parser = formatter . toScientific <$> Parser.number
58+
59+doubleExpFP :: Property
60+doubleExpFP =
61+ forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls -> do
62+ let sls = show ls
63+ case runIdentity $ Stream.parse Parser.double (Stream.fromList sls) of
64+ Right val -> if val == ls
65+ then property (val == ls)
66+ else trace
67+ ("Read = "++ show (read sls :: Double) ++ " Expected = " ++ sls ++ " Got = " ++ show val)
68+ property (val == ls)
69+ Left _ -> property False
70+
71+-- Standard decimal notation.
72+doubleFixFP :: Property
73+doubleFixFP =
74+ forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->
75+ case runIdentity $ Stream.parse Parser.double (Stream.fromList (show ls)) of
76+ Right val -> if val == ls
77+ then property (val == ls)
78+ else trace
79+ ("Expected = " ++ show ls ++ " Got = " ++ show val)
80+ property (val == ls)
81+ Left _ -> property False
1882
1983doubleParser :: String -> IO (Either ParseError Double)
2084doubleParser = Stream.parse Unicode.double . Stream.fromList
@@ -23,15 +87,19 @@ double :: String -> Double -> Property
2387double s d = monadicIO $ do
2488 x <- run $ doubleParser s
2589 case x of
26− Right val -> trace ("parsed " ++ show val) (assert (val == d))
27− Left (ParseError _) -> assert (False)
90+ Right val -> if val == d
91+ then assert (val == d)
92+ else trace ("Expectedc = " ++ show d ++ " Got = "++ show val) (assert (val == d))
93+ Left (ParseError _) -> assert False
2894
2995doubleErr :: String -> String -> Property
3096doubleErr s msg = monadicIO $ do
3197 x <- run $ doubleParser s
3298 case x of
33− Right _ -> assert (False)
34− Left (ParseError err) -> trace err (assert (err == msg))
99+ Right _ -> assert False
100+ Left (ParseError err) -> if err == msg
101+ then assert (err == msg)
102+ else trace err (assert (err == msg))
35103
36104remainingStream :: String -> [String]
37105remainingStream x =
@@ -118,3 +186,9 @@ main = do
118186 prop "afterParse \"..\" \"..\"" $ afterParse ".." ".."
119187 prop "afterParse \"+\" \"+\"" $ afterParse "+" "+"
120188 prop "afterParse \"++\" \"++\"" $ afterParse "++" "++"
189+ H.describe "Scientific parser property test" $ do
190+ prop "Exponent format" scientificExpFP
191+ prop "Decimal format" scientificFixFP
192+ H.describe "double parser property test" $ do
193+ prop "Exponent format" doubleExpFP
194+ prop "Decimal format" doubleFixFP