mirror of
https://github.com/ilyakooo0/streamly.git
synced 2024-09-11 08:25:40 +03:00
Add benchmarks and property test for double Parser
This commit is contained in:
parent
eee265456e
commit
efe0be398c
@ -4,17 +4,81 @@ module Streamly.Test.Unicode.Parser
|
|||||||
(main)
|
(main)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Streamly.Internal.Data.Parser (ParseError (..))
|
import Control.Monad.Identity (Identity(runIdentity))
|
||||||
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 Debug.Trace (trace)
|
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 :: String -> IO (Either ParseError Double)
|
||||||
doubleParser = Stream.parse Unicode.double . Stream.fromList
|
doubleParser = Stream.parse Unicode.double . Stream.fromList
|
||||||
@ -23,15 +87,19 @@ double :: String -> Double -> Property
|
|||||||
double s d = monadicIO $ do
|
double s d = monadicIO $ do
|
||||||
x <- run $ doubleParser s
|
x <- run $ doubleParser s
|
||||||
case x of
|
case x of
|
||||||
Right val -> trace ("parsed " ++ show val) (assert (val == d))
|
Right val -> if val == d
|
||||||
Left (ParseError _) -> assert (False)
|
then assert (val == d)
|
||||||
|
else trace ("Expectedc = " ++ show d ++ " Got = "++ show val) (assert (val == d))
|
||||||
|
Left (ParseError _) -> assert False
|
||||||
|
|
||||||
doubleErr :: String -> String -> Property
|
doubleErr :: String -> String -> Property
|
||||||
doubleErr s msg = monadicIO $ do
|
doubleErr s msg = monadicIO $ do
|
||||||
x <- run $ doubleParser s
|
x <- run $ doubleParser s
|
||||||
case x of
|
case x of
|
||||||
Right _ -> assert (False)
|
Right _ -> assert False
|
||||||
Left (ParseError err) -> trace err (assert (err == msg))
|
Left (ParseError err) -> if err == msg
|
||||||
|
then assert (err == msg)
|
||||||
|
else trace err (assert (err == msg))
|
||||||
|
|
||||||
remainingStream :: String -> [String]
|
remainingStream :: String -> [String]
|
||||||
remainingStream x =
|
remainingStream x =
|
||||||
@ -118,3 +186,9 @@ main = do
|
|||||||
prop "afterParse \"..\" \"..\"" $ afterParse ".." ".."
|
prop "afterParse \"..\" \"..\"" $ afterParse ".." ".."
|
||||||
prop "afterParse \"+\" \"+\"" $ afterParse "+" "+"
|
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
|
||||||
|
@ -12,6 +12,7 @@ module Streamly.Test.Common
|
|||||||
, listEquals
|
, listEquals
|
||||||
, checkListEqual
|
, checkListEqual
|
||||||
, chooseInt
|
, chooseInt
|
||||||
|
, chooseDouble
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (when)
|
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 :: (Int, Int) -> Gen Int
|
||||||
chooseInt = choose
|
chooseInt = choose
|
||||||
|
|
||||||
|
chooseDouble :: (Double, Double) -> Gen Double
|
||||||
|
chooseDouble = choose
|
||||||
|
@ -158,6 +158,7 @@ common test-dependencies
|
|||||||
, filepath >= 1.4.1 && < 1.5
|
, filepath >= 1.4.1 && < 1.5
|
||||||
, temporary >= 1.3 && < 1.4
|
, temporary >= 1.3 && < 1.4
|
||||||
, network >= 3.1 && < 3.2
|
, network >= 3.1 && < 3.2
|
||||||
|
, scientific >= 0.0 && < 0.4
|
||||||
|
|
||||||
if !flag(use-streamly-core)
|
if !flag(use-streamly-core)
|
||||||
build-depends: streamly
|
build-depends: streamly
|
||||||
|
Loading…
Reference in New Issue
Block a user