git.iko.soy/streamly
on eed4308 help sign in
streamly/test/Streamly/Test/Unicode/Parser.hs
231 lines 10 kB history raw
1{-# OPTIONS_GHC -Wno-deprecations #-}
3module Streamly.Test.Unicode.Parser
4 (main)
5where
7import Control.Monad.Identity (Identity(runIdentity))
8import Debug.Trace (trace)
9import Streamly.Internal.Data.Parser (ParseError (..), Parser)
10import Streamly.Test.Common (chooseDouble)
11import Test.Hspec.QuickCheck (prop)
12import Test.QuickCheck
13 (forAll, Property, property)
14import Test.QuickCheck.Monadic (monadicIO, assert, run)
16import qualified Data.Scientific as Scientific
17import qualified Streamly.Data.Stream as Stream
18import qualified Streamly.Internal.Data.Stream as Stream (parseBreak)
19import qualified Streamly.Unicode.Parser as Unicode
20import qualified Streamly.Internal.Unicode.Parser as Parser
21import qualified Test.Hspec as H
23-- Scientific notation
24scientificExpFP :: Property
25scientificExpFP =
26 forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls ->
27 case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of
28 Right val -> val `H.shouldBe` read (show ls)
29 Left _ -> error "Parsing failed."
31 where
33 toScientific (c, m) = Scientific.scientific c m
34 parser = toScientific <$> Parser.number
36-- Standard decimal notation.
37scientificFixFP :: Property
38scientificFixFP =
39 forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->
40 case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of
41 Right val -> val `H.shouldBe` read (show ls)
42 Left _ -> error "Parsing failed."
44 where
46 toScientific (c, m) = Scientific.scientific c m
47 parser = toScientific <$> Parser.number
49doubleExpFP :: Property
50doubleExpFP =
51 forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls -> do
52 let sls = show ls
53 case runIdentity $ Stream.parse Parser.double (Stream.fromList sls) of
54 Right val -> if val == ls
55 then property (val == ls)
56 else trace
57 ("Read = "++ show (read sls :: Double) ++ " Expected = " ++ sls ++ " Got = " ++ show val)
58 property (val == ls)
59 Left _ -> property False
61-- Standard decimal notation.
62doubleFixFP :: Property
63doubleFixFP =
64 forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->
65 case runIdentity $ Stream.parse Parser.double (Stream.fromList (show ls)) of
66 Right val -> if val == ls
67 then property (val == ls)
68 else trace
69 ("Expected = " ++ show ls ++ " Got = " ++ show val)
70 property (val == ls)
71 Left _ -> property False
73doubleParser :: String -> IO (Either ParseError Double)
74doubleParser = Stream.parse Unicode.double . Stream.fromList
76double :: String -> Double -> Property
77double s d = monadicIO $ do
78 x <- run $ doubleParser s
79 case x of
80 Right val -> if val == d
81 then assert (val == d)
82 else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d))
83 Left (ParseError _) -> assert False
85numberP :: Monad m => Parser Char m Double
86numberP = uncurry Parser.mkDouble <$> Parser.number
88numberParser :: String -> IO (Either ParseError Double)
89numberParser = Stream.parse numberP . Stream.fromList
91number :: String -> Double -> Property
92number s d = monadicIO $ do
93 x <- run $ numberParser s
94 case x of
95 Right val -> if val == d
96 then assert (val == d)
97 else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d))
98 Left (ParseError _) -> assert False
100doubleErr :: (String -> IO (Either ParseError Double)) -> String -> String -> Property
101doubleErr f s msg = monadicIO $ do
102 x <- run $ f s
103 case x of
104 Right _ -> assert False
105 Left (ParseError err) -> if err == msg
106 then assert (err == msg)
107 else trace err (assert (err == msg))
109remainingStreamDouble :: String -> [String]
110remainingStreamDouble x =
111 let f = Stream.parseBreak Unicode.double . Stream.fromList
112 in concatMap (Stream.toList . snd) (f x)
114remainingStreamNumber :: String -> [String]
115remainingStreamNumber x =
116 let f = Stream.parseBreak numberP . Stream.fromList
117 in concatMap (Stream.toList . snd) (f x)
119afterParse :: (String -> [String]) -> String -> String -> Property
120afterParse f si so = monadicIO $ do
121 let x = f si
122 in assert (x == [so])
124testParser :: String -> (String -> Double -> Property) -> H.SpecWith ()
125testParser desc f = do
126 -- XXX We can combine the parser tests and remaining stream tests in the
127 -- same test.
128 H.describe ("Unicode Parser " ++ desc) $ do
129 prop "double \"00.00\"" $ f "00.00" 0.0
130 prop "double \"00.00e00\"" $ f "00.00e00" 0.0
131 prop "double \"4\" 4.0" $ f "4" 4.0
132 prop "double \"00.3\" 0.3" $ f "00.3" 0.3
133 prop "double \"0.003\" 3.0e-3" $ f "0.003" 3.0e-3
134 prop "double \"44.56.67\" 44.56" $ f "44.56.67" 44.56
135 prop "double \"0.0.00\" 0.0" $ f "0.0.00" 0.0
136 prop "double \"44.56-78\" 44.56" $ f "44.56-78" 44.56
137 prop "double \"44-\" 44.0" $ f "44-" 44.0
138 prop "double \"44-56\" 44.0" $ f "44-56" 44.0
139 prop "double \"44+\" 44.0" $ f "44+" 44.0
140 prop "double \"44+56\" 44.0" $ f "44+56" 44.0
141 prop "double \"44u\" 44.0" $ f "44u" 44.0
142 prop "double \"+123.345\" 123.345" $ f "+123.345" 123.345
143 prop "double \"-123.345\" (-123.345)" $ f "-123.345" (-123.345)
144 prop "double \"1e\"" $ f "1e" 1.0
145 prop "double \"1e+\"" $ f "1e+" 1.0
146 prop "double \"1ex\"" $ f "1ex" 1.0
147 prop "double \"1e+x\"" $ f "1e+x" 1.0
148 prop "double \"1e+0\"" $ f "1e+0" 1.0
149 prop "double \"1e-0\"" $ f "1e-0" 1.0
150 prop "double \"1.0e-1\"" $ f "1.0e-1" 0.1
151 prop "double \"1.0e+1\"" $ f "1.0e+1" 10.0
152 prop "double \"1.0e1\"" $ f "1.0e1" 10.0
153 prop "double \"1.0e+309\"" $ f "1.0e+309" 1.0e309
154 prop "double \"1.0e-309\"" $ f "1.0e-309" 1.0e-309
155 prop "double \"1.0e1.\"" $ f "1.0e1." 10.0
156 prop "double \"1.0e1+\"" $ f "1.0e1+" 10.0
157 prop "double \"1.0e1-\"" $ f "1.0e1-" 10.0
158 prop "double \"1.0e1e\"" $ f "1.0e1e" 10.0
159 prop "double \"1.0E+1\"" $ f "1.0E+1" 10.0
160 prop "double \"9223372036854775806\"" $ f "9223372036854775806" 9.223372036854776e18
161 -- maxBound :: Int
162 prop "double \"9223372036854775807\"" $ f "9223372036854775807" 9.223372036854776e18
163 prop "double \"9223372036854775808\"" $ f "9223372036854775808" 9.223372036854776e18
165testParseErr :: String -> (String -> IO (Either ParseError Double)) -> H.SpecWith ()
166testParseErr desc f = do
167 H.describe ("Unicode Parser Error " ++ desc) $ do
168 prop "double \"\" Error"
169 $ doubleErr f "" "number: expecting sign or decimal digit, got end of input"
170 prop "double \"a\" Error"
171 $ doubleErr f "a" "number: expecting sign or decimal digit, got 'a'"
172 prop "double \".4\" Error"
173 $ doubleErr f ".4" "number: expecting sign or decimal digit, got '.'"
174 prop "double \".\" Error"
175 $ doubleErr f "." "number: expecting sign or decimal digit, got '.'"
176 prop "double \"..\" Error"
177 $ doubleErr f ".." "number: expecting sign or decimal digit, got '.'"
178 prop "double \"-\" Error"
179 $ doubleErr f "-" "number: expecting decimal digit, got end of input"
180 prop "double \"+\" Error"
181 $ doubleErr f "+" "number: expecting decimal digit, got end of input"
182 prop "double \"++\" Error"
183 $ doubleErr f "++" "number: expecting decimal digit, got '+'"
185testLeftOver :: String -> (String -> [String]) -> H.SpecWith ()
186testLeftOver desc f = do
187 H.describe ("Unicode Parser leftover " ++ desc) $ do
188 prop "afterParse \"4.\" \".\"" $ afterParse f "4." "."
189 prop "afterParse \"4..\" \"..\"" $ afterParse f "4.." ".."
190 prop "afterParse \"4-\" \"-\"" $ afterParse f "4-" "-"
191 prop "afterParse \"4--\" \"--\"" $ afterParse f "4--" "--"
192 prop "afterParse \"4.9abc\" \"abc\"" $ afterParse f "4.9abc" "abc"
193 prop "afterParse \"4.9ex\"" $ afterParse f "4.9ex" "ex"
194 prop "afterParse \"4.9e+x\"" $ afterParse f "4.9e+x" "e+x"
195 prop "afterParse \"4.9\" \"\"" $ afterParse f "4.9" ""
196 prop "afterParse \"+4.9\" \"\"" $ afterParse f "+4.9" ""
197 prop "afterParse \"-4.9\" \"\"" $ afterParse f "-4.9" ""
198 prop "afterParse \"4.9.\" \".\"" $ afterParse f "4.9." "."
199 prop "afterParse \"4.9..\" \"..\"" $ afterParse f "4.9.." ".."
200 prop "afterParse \"4.9...\" \"...\"" $ afterParse f "4.9..." "..."
201 prop "afterParse \"4.9+\" \"+\"" $ afterParse f "4.9+" "+"
202 prop "afterParse \"4.9++\" \"++\"" $ afterParse f "4.9++" "++"
203 prop "afterParse \"4.9+++\" \"+++\"" $ afterParse f "4.9+++" "+++"
204 prop "afterParse \"4.9-\" \"-\"" $ afterParse f "4.9-" "-"
205 prop "afterParse \"4.9--\" \"--\"" $ afterParse f "4.9--" "--"
206 prop "afterParse \"4.9---\" \"---\"" $ afterParse f "4.9---" "---"
207 prop "afterParse \"\" \"\"" $ afterParse f "" ""
208 prop "afterParse \".\" \".\"" $ afterParse f "." "."
209 prop "afterParse \"..\" \"..\"" $ afterParse f ".." ".."
210 prop "afterParse \"+\" \"+\"" $ afterParse f "+" "+"
211 prop "afterParse \"++\" \"++\"" $ afterParse f "++" "++"
213moduleName :: String
214moduleName = "Unicode.Parser"
216main :: IO ()
217main = do
218 H.hspec
219 $ H.describe moduleName $ do
220 testParser "double" double
221 testParser "number" number
222 testParseErr "double" doubleParser
223 testParseErr "number" numberParser
224 testLeftOver "double" remainingStreamDouble
225 testLeftOver "number" remainingStreamNumber
226 H.describe "Scientific parser property test" $ do
227 prop "Exponent format" scientificExpFP
228 prop "Decimal format" scientificFixFP
229 H.describe "double parser property test" $ do
230 prop "Exponent format" doubleExpFP
231 prop "Decimal format" doubleFixFP