git.iko.soy/streamly
on 52ddfee help sign in
streamly/test/Streamly/Test/Unicode/Parser.hs
241 lines 11 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 -> 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
35 where
37 formatter = Scientific.formatScientific Scientific.Exponent Nothing
38 toScientific (c, m) = Scientific.scientific c m
39 parser = formatter . toScientific <$> Parser.number
41-- Standard decimal notation.
42scientificFixFP :: Property
43scientificFixFP =
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
53 where
55 formatter = Scientific.formatScientific Scientific.Fixed Nothing
56 toScientific (c, m) = Scientific.scientific c m
57 parser = formatter . toScientific <$> Parser.number
59doubleExpFP :: Property
60doubleExpFP =
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
71-- Standard decimal notation.
72doubleFixFP :: Property
73doubleFixFP =
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
83doubleParser :: String -> IO (Either ParseError Double)
84doubleParser = Stream.parse Unicode.double . Stream.fromList
86double :: String -> Double -> Property
87double s d = monadicIO $ do
88 x <- run $ doubleParser s
89 case x of
90 Right val -> if val == d
91 then assert (val == d)
92 else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d))
93 Left (ParseError _) -> assert False
95numberP :: Monad m => Parser Char m Double
96numberP = uncurry Parser.mkDouble <$> Parser.number
98numberParser :: String -> IO (Either ParseError Double)
99numberParser = Stream.parse numberP . Stream.fromList
101number :: String -> Double -> Property
102number s d = monadicIO $ do
103 x <- run $ numberParser s
104 case x of
105 Right val -> if val == d
106 then assert (val == d)
107 else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d))
108 Left (ParseError _) -> assert False
110doubleErr :: (String -> IO (Either ParseError Double)) -> String -> String -> Property
111doubleErr f s msg = monadicIO $ do
112 x <- run $ f s
113 case x of
114 Right _ -> assert False
115 Left (ParseError err) -> if err == msg
116 then assert (err == msg)
117 else trace err (assert (err == msg))
119remainingStreamDouble :: String -> [String]
120remainingStreamDouble x =
121 let f = Stream.parseBreak Unicode.double . Stream.fromList
122 in concatMap (Stream.toList . snd) (f x)
124remainingStreamNumber :: String -> [String]
125remainingStreamNumber x =
126 let f = Stream.parseBreak numberP . Stream.fromList
127 in concatMap (Stream.toList . snd) (f x)
129afterParse :: (String -> [String]) -> String -> String -> Property
130afterParse f si so = monadicIO $ do
131 let x = f si
132 in assert (x == [so])
134testParser :: String -> (String -> Double -> Property) -> H.SpecWith ()
135testParser desc f = do
136 -- XXX We can combine the parser tests and remaining stream tests in the
137 -- same test.
138 H.describe ("Unicode Parser " ++ desc) $ do
139 prop "double \"00.00\"" $ f "00.00" 0.0
140 prop "double \"00.00e00\"" $ f "00.00e00" 0.0
141 prop "double \"4\" 4.0" $ f "4" 4.0
142 prop "double \"00.3\" 0.3" $ f "00.3" 0.3
143 prop "double \"0.003\" 3.0e-3" $ f "0.003" 3.0e-3
144 prop "double \"44.56.67\" 44.56" $ f "44.56.67" 44.56
145 prop "double \"0.0.00\" 0.0" $ f "0.0.00" 0.0
146 prop "double \"44.56-78\" 44.56" $ f "44.56-78" 44.56
147 prop "double \"44-\" 44.0" $ f "44-" 44.0
148 prop "double \"44-56\" 44.0" $ f "44-56" 44.0
149 prop "double \"44+\" 44.0" $ f "44+" 44.0
150 prop "double \"44+56\" 44.0" $ f "44+56" 44.0
151 prop "double \"44u\" 44.0" $ f "44u" 44.0
152 prop "double \"+123.345\" 123.345" $ f "+123.345" 123.345
153 prop "double \"-123.345\" (-123.345)" $ f "-123.345" (-123.345)
154 prop "double \"1e\"" $ f "1e" 1.0
155 prop "double \"1e+\"" $ f "1e+" 1.0
156 prop "double \"1ex\"" $ f "1ex" 1.0
157 prop "double \"1e+x\"" $ f "1e+x" 1.0
158 prop "double \"1e+0\"" $ f "1e+0" 1.0
159 prop "double \"1e-0\"" $ f "1e-0" 1.0
160 prop "double \"1.0e-1\"" $ f "1.0e-1" 0.1
161 prop "double \"1.0e+1\"" $ f "1.0e+1" 10.0
162 prop "double \"1.0e1\"" $ f "1.0e1" 10.0
163 prop "double \"1.0e+309\"" $ f "1.0e+309" 1.0e309
164 prop "double \"1.0e-309\"" $ f "1.0e-309" 1.0e-309
165 prop "double \"1.0e1.\"" $ f "1.0e1." 10.0
166 prop "double \"1.0e1+\"" $ f "1.0e1+" 10.0
167 prop "double \"1.0e1-\"" $ f "1.0e1-" 10.0
168 prop "double \"1.0e1e\"" $ f "1.0e1e" 10.0
169 prop "double \"1.0E+1\"" $ f "1.0E+1" 10.0
170 prop "double \"9223372036854775806\"" $ f "9223372036854775806" 9.223372036854776e18
171 -- maxBound :: Int
172 prop "double \"9223372036854775807\"" $ f "9223372036854775807" 9.223372036854776e18
173 prop "double \"9223372036854775808\"" $ f "9223372036854775808" 9.223372036854776e18
175testParseErr :: String -> (String -> IO (Either ParseError Double)) -> H.SpecWith ()
176testParseErr desc f = do
177 H.describe ("Unicode Parser Error " ++ desc) $ do
178 prop "double \"\" Error"
179 $ doubleErr f "" "number: expecting sign or decimal digit, got end of input"
180 prop "double \"a\" Error"
181 $ doubleErr f "a" "number: expecting sign or decimal digit, got 'a'"
182 prop "double \".4\" Error"
183 $ doubleErr f ".4" "number: expecting sign or decimal digit, got '.'"
184 prop "double \".\" Error"
185 $ doubleErr f "." "number: expecting sign or decimal digit, got '.'"
186 prop "double \"..\" Error"
187 $ doubleErr f ".." "number: expecting sign or decimal digit, got '.'"
188 prop "double \"-\" Error"
189 $ doubleErr f "-" "number: expecting decimal digit, got end of input"
190 prop "double \"+\" Error"
191 $ doubleErr f "+" "number: expecting decimal digit, got end of input"
192 prop "double \"++\" Error"
193 $ doubleErr f "++" "number: expecting decimal digit, got '+'"
195testLeftOver :: String -> (String -> [String]) -> H.SpecWith ()
196testLeftOver desc f = do
197 H.describe ("Unicode Parser leftover " ++ desc) $ do
198 prop "afterParse \"4.\" \".\"" $ afterParse f "4." "."
199 prop "afterParse \"4..\" \"..\"" $ afterParse f "4.." ".."
200 prop "afterParse \"4-\" \"-\"" $ afterParse f "4-" "-"
201 prop "afterParse \"4--\" \"--\"" $ afterParse f "4--" "--"
202 prop "afterParse \"4.9abc\" \"abc\"" $ afterParse f "4.9abc" "abc"
203 prop "afterParse \"4.9ex\"" $ afterParse f "4.9ex" "ex"
204 prop "afterParse \"4.9e+x\"" $ afterParse f "4.9e+x" "e+x"
205 prop "afterParse \"4.9\" \"\"" $ afterParse f "4.9" ""
206 prop "afterParse \"+4.9\" \"\"" $ afterParse f "+4.9" ""
207 prop "afterParse \"-4.9\" \"\"" $ afterParse f "-4.9" ""
208 prop "afterParse \"4.9.\" \".\"" $ afterParse f "4.9." "."
209 prop "afterParse \"4.9..\" \"..\"" $ afterParse f "4.9.." ".."
210 prop "afterParse \"4.9...\" \"...\"" $ afterParse f "4.9..." "..."
211 prop "afterParse \"4.9+\" \"+\"" $ afterParse f "4.9+" "+"
212 prop "afterParse \"4.9++\" \"++\"" $ afterParse f "4.9++" "++"
213 prop "afterParse \"4.9+++\" \"+++\"" $ afterParse f "4.9+++" "+++"
214 prop "afterParse \"4.9-\" \"-\"" $ afterParse f "4.9-" "-"
215 prop "afterParse \"4.9--\" \"--\"" $ afterParse f "4.9--" "--"
216 prop "afterParse \"4.9---\" \"---\"" $ afterParse f "4.9---" "---"
217 prop "afterParse \"\" \"\"" $ afterParse f "" ""
218 prop "afterParse \".\" \".\"" $ afterParse f "." "."
219 prop "afterParse \"..\" \"..\"" $ afterParse f ".." ".."
220 prop "afterParse \"+\" \"+\"" $ afterParse f "+" "+"
221 prop "afterParse \"++\" \"++\"" $ afterParse f "++" "++"
223moduleName :: String
224moduleName = "Unicode.Parser"
226main :: IO ()
227main = do
228 H.hspec
229 $ H.describe moduleName $ do
230 testParser "double" double
231 testParser "number" number
232 testParseErr "double" doubleParser
233 testParseErr "number" numberParser
234 testLeftOver "double" remainingStreamDouble
235 testLeftOver "number" remainingStreamNumber
236 H.describe "Scientific parser property test" $ do
237 prop "Exponent format" scientificExpFP
238 prop "Decimal format" scientificFixFP
239 H.describe "double parser property test" $ do
240 prop "Exponent format" doubleExpFP
241 prop "Decimal format" doubleFixFP