git.iko.soy/streamly
on master help sign in
Remove redundant parsers, update docs
d5af0bfHarendra Kumar
benchmark/Streamly/Benchmark/Data/Parser.hs+68−49
compare with master
unifiedsplit
@@ -15,6 +15,7 @@ module Main
15import Control.DeepSeq (NFData(..))
15import Control.DeepSeq (NFData(..))
16import Control.Monad.Catch (MonadCatch)
16import Control.Monad.Catch (MonadCatch)
17import Data.Foldable (asum)
17import Data.Foldable (asum)
18+import Data.Functor (($>))
18import Data.Monoid (Sum(..))
19import Data.Monoid (Sum(..))
19import System.Random (randomRIO)
20import System.Random (randomRIO)
20import Prelude
21import Prelude
@@ -59,22 +60,14 @@ benchIOSink value name f =
59-- Parsers
60-- Parsers
60-------------------------------------------------------------------------------
61-------------------------------------------------------------------------------
61
62
62−{-# INLINE any #-}
63−any :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
64−any value = IP.parse (PR.any (> value))
65−
66−{-# INLINE all #-}
67−all :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
68−all value = IP.parse (PR.all (<= value))
69−
70−{-# INLINE take #-}
71−take :: MonadCatch m => Int -> SerialT m a -> m ()
72−take value = IP.parse (PR.take value FL.drain)
73−
74{-# INLINE takeEQ #-}
63{-# INLINE takeEQ #-}
75takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()
64takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()
76takeEQ value = IP.parse (PR.takeEQ value FL.drain)
65takeEQ value = IP.parse (PR.takeEQ value FL.drain)
77
66
67+{-# INLINE drainWhile #-}
68+drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
69+drainWhile value = IP.parse (PR.drainWhile (<= value))
70+
78{-# INLINE takeWhile #-}
71{-# INLINE takeWhile #-}
79takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
72takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
80takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
73takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
@@ -106,57 +99,91 @@ manyTill value =
106
99
107{-# INLINE splitAp #-}
100{-# INLINE splitAp #-}
108splitAp :: MonadCatch m
101splitAp :: MonadCatch m
109− => Int -> SerialT m Int -> m (Bool, Bool)
102+ => Int -> SerialT m Int -> m ((), ())
110splitAp value =
103splitAp value =
104+ IP.parse
105+ ((,)
111− IP.parse ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
106+ <$> PR.drainWhile (<= (value `div` 2))
107+ <*> PR.drainWhile (<= value)
108+ )
112
109
113{-# INLINE splitApBefore #-}
110{-# INLINE splitApBefore #-}
114splitApBefore :: MonadCatch m
111splitApBefore :: MonadCatch m
115− => Int -> SerialT m Int -> m Bool
112+ => Int -> SerialT m Int -> m ()
116splitApBefore value =
113splitApBefore value =
114+ IP.parse
117− IP.parse (PR.all (<= (value `div` 2)) *> PR.any (> value))
115+ ( PR.drainWhile (<= (value `div` 2))
116+ *> PR.drainWhile (<= value)
117+ )
118
118
119{-# INLINE splitApAfter #-}
119{-# INLINE splitApAfter #-}
120splitApAfter :: MonadCatch m
120splitApAfter :: MonadCatch m
121− => Int -> SerialT m Int -> m Bool
121+ => Int -> SerialT m Int -> m ()
122splitApAfter value =
122splitApAfter value =
123+ IP.parse
123− IP.parse (PR.all (<= (value `div` 2)) <* PR.any (> value))
124+ ( PR.drainWhile (<= (value `div` 2))
125+ <* PR.drainWhile (<= value)
126+ )
124
127
125{-# INLINE splitWith #-}
128{-# INLINE splitWith #-}
126splitWith :: MonadCatch m
129splitWith :: MonadCatch m
127− => Int -> SerialT m Int -> m (Bool, Bool)
130+ => Int -> SerialT m Int -> m ((), ())
128splitWith value =
131splitWith value =
132+ IP.parse
129− IP.parse (PR.splitWith (,) (PR.all (<= (value `div` 2))) (PR.any (> value)))
133+ (PR.splitWith (,)
134+ (PR.drainWhile (<= (value `div` 2)))
135+ (PR.drainWhile (<= value))
136+ )
130
137
131{-# INLINE split_ #-}
138{-# INLINE split_ #-}
132split_ :: MonadCatch m
139split_ :: MonadCatch m
133− => Int -> SerialT m Int -> m Bool
140+ => Int -> SerialT m Int -> m ()
134split_ value =
141split_ value =
135− IP.parse (PR.split_ (PR.all (<= (value `div` 2))) (PR.any (> value)))
142+ IP.parse
143+ (PR.split_
144+ (PR.drainWhile (<= (value `div` 2)))
145+ (PR.drainWhile (<= value))
146+ )
136
147
137{-# INLINE teeAllAny #-}
148{-# INLINE teeAllAny #-}
138−teeAllAny :: (MonadCatch m, Ord a)
149+teeAllAny :: MonadCatch m
139− => a -> SerialT m a -> m (Bool, Bool)
150+ => Int -> SerialT m Int -> m ((), ())
140teeAllAny value =
151teeAllAny value =
152+ IP.parse
141− IP.parse (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
153+ (PR.teeWith (,)
154+ (PR.drainWhile (<= value))
155+ (PR.drainWhile (<= value))
156+ )
142
157
143{-# INLINE teeFstAllAny #-}
158{-# INLINE teeFstAllAny #-}
144−teeFstAllAny :: (MonadCatch m, Ord a)
159+teeFstAllAny :: MonadCatch m
145− => a -> SerialT m a -> m (Bool, Bool)
160+ => Int -> SerialT m Int -> m ((), ())
146teeFstAllAny value =
161teeFstAllAny value =
162+ IP.parse
147− IP.parse (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
163+ (PR.teeWithFst (,)
164+ (PR.drainWhile (<= value))
165+ (PR.drainWhile (<= value))
166+ )
148
167
149{-# INLINE shortestAllAny #-}
168{-# INLINE shortestAllAny #-}
150−shortestAllAny :: (MonadCatch m, Ord a)
169+shortestAllAny :: MonadCatch m
151− => a -> SerialT m a -> m Bool
170+ => Int -> SerialT m Int -> m ()
152shortestAllAny value =
171shortestAllAny value =
172+ IP.parse
153− IP.parse (PR.shortest (PR.all (<= value)) (PR.any (> value)))
173+ (PR.shortest
174+ (PR.drainWhile (<= value))
175+ (PR.drainWhile (<= value))
176+ )
154
177
155{-# INLINE longestAllAny #-}
178{-# INLINE longestAllAny #-}
156−longestAllAny :: (MonadCatch m, Ord a)
179+longestAllAny :: MonadCatch m
157− => a -> SerialT m a -> m Bool
180+ => Int -> SerialT m Int -> m ()
158longestAllAny value =
181longestAllAny value =
182+ IP.parse
159− IP.parse (PR.longest (PR.all (<= value)) (PR.any (> value)))
183+ (PR.longest
184+ (PR.drainWhile (<= value))
185+ (PR.drainWhile (<= value))
186+ )
160
187
161-------------------------------------------------------------------------------
188-------------------------------------------------------------------------------
162-- Parsers in which -fspec-constr-recursive=16 is problematic
189-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -169,7 +196,7 @@ longestAllAny value =
169{-# INLINE lookAhead #-}
196{-# INLINE lookAhead #-}
170lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
197lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
171lookAhead value =
198lookAhead value =
172− IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
199+ IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
173
200
174{-# INLINE sequenceA #-}
201{-# INLINE sequenceA #-}
175sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
202sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
@@ -208,7 +235,7 @@ parseMany :: MonadCatch m => SerialT m Int -> m ()
208parseMany =
235parseMany =
209 S.drain
236 S.drain
210 . S.map getSum
237 . S.map getSum
211− . IP.parseMany (PR.take 2 FL.mconcat)
238+ . IP.parseMany (PR.fromFold $ FL.ltake 2 FL.mconcat)
212 . S.map Sum
239 . S.map Sum
213
240
214{-# INLINE parseIterate #-}
241{-# INLINE parseIterate #-}
@@ -216,7 +243,7 @@ parseIterate :: MonadCatch m => SerialT m Int -> m ()
216parseIterate =
243parseIterate =
217 S.drain
244 S.drain
218 . S.map getSum
245 . S.map getSum
219− . IP.parseIterate (\b -> (PR.take 2 (FL.sconcat b))) (Sum 0)
246+ . IP.parseIterate (PR.fromFold . FL.ltake 2 . FL.sconcat) (Sum 0)
220 . S.map Sum
247 . S.map Sum
221
248
222-------------------------------------------------------------------------------
249-------------------------------------------------------------------------------
@@ -228,11 +255,9 @@ moduleName = "Data.Parser"
228
255
229o_1_space_serial :: Int -> [Benchmark]
256o_1_space_serial :: Int -> [Benchmark]
230o_1_space_serial value =
257o_1_space_serial value =
231− [ benchIOSink value "any" $ any value
258+ [ benchIOSink value "takeEQ" $ takeEQ value
232− , benchIOSink value "all" $ all value
233− , benchIOSink value "take" $ take value
234− , benchIOSink value "takeEQ" $ takeEQ value
235 , benchIOSink value "takeWhile" $ takeWhile value
259 , benchIOSink value "takeWhile" $ takeWhile value
260+ , benchIOSink value "drainWhile" $ drainWhile value
236 , benchIOSink value "splitAp" $ splitAp value
261 , benchIOSink value "splitAp" $ splitAp value
237 , benchIOSink value "splitApBefore" $ splitApBefore value
262 , benchIOSink value "splitApBefore" $ splitApBefore value
238 , benchIOSink value "splitApAfter" $ splitApAfter value
263 , benchIOSink value "splitApAfter" $ splitApAfter value
@@ -284,12 +309,6 @@ main = do
284 where
309 where
285
310
286 allBenchmarks value =
311 allBenchmarks value =
287− [ bgroup (o_1_space_prefix moduleName) $ concat
312+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
288− [
289− o_1_space_serial value
290− ]
291− , bgroup (o_n_heap_prefix moduleName) $ concat
313+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
292− [
293− o_n_heap_serial value
294− ]
295 ]
314 ]
benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+44−43
@@ -16,6 +16,7 @@ module Main
16import Control.DeepSeq (NFData(..))
16import Control.DeepSeq (NFData(..))
17import Control.Monad.Catch (MonadCatch, MonadThrow)
17import Control.Monad.Catch (MonadCatch, MonadThrow)
18import Data.Foldable (asum)
18import Data.Foldable (asum)
19+import Data.Functor (($>))
19import System.Random (randomRIO)
20import System.Random (randomRIO)
20import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
21import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
21
22
@@ -58,21 +59,13 @@ benchIOSink value name f =
58-- Parsers
59-- Parsers
59-------------------------------------------------------------------------------
60-------------------------------------------------------------------------------
60
61
61−{-# INLINE any #-}
62+{-# INLINE drainWhile #-}
62−any :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
63+drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()
63−any value = IP.parseD (PR.any (> value))
64+drainWhile p = PR.takeWhile p FL.drain
64−
65−{-# INLINE all #-}
66−all :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
67−all value = IP.parseD (PR.all (<= value))
68−
69−{-# INLINE take #-}
70−take :: MonadThrow m => Int -> SerialT m a -> m ()
71−take value = IP.parseD (PR.take value FL.drain)
72
65
73{-# INLINE takeWhile #-}
66{-# INLINE takeWhile #-}
74takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
67takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
75−takeWhile value = IP.parseD (PR.takeWhile (<= value) FL.drain)
68+takeWhile value = IP.parseD (drainWhile (<= value))
76
69
77{-# INLINE many #-}
70{-# INLINE many #-}
78many :: MonadCatch m => SerialT m Int -> m Int
71many :: MonadCatch m => SerialT m Int -> m Int
@@ -103,33 +96,53 @@ manyTill value =
103
96
104{-# INLINE splitAllAny #-}
97{-# INLINE splitAllAny #-}
105splitAllAny :: MonadThrow m
98splitAllAny :: MonadThrow m
106− => Int -> SerialT m Int -> m (Bool, Bool)
99+ => Int -> SerialT m Int -> m ((), ())
107splitAllAny value =
100splitAllAny value =
108− IP.parseD ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
101+ IP.parseD
102+ ((,)
103+ <$> drainWhile (<= (value `div` 2))
104+ <*> drainWhile (<= value)
105+ )
109
106
110{-# INLINE teeAllAny #-}
107{-# INLINE teeAllAny #-}
111−teeAllAny :: (MonadThrow m, Ord a)
108+teeAllAny :: MonadThrow m
112− => a -> SerialT m a -> m (Bool, Bool)
109+ => Int -> SerialT m Int -> m ((), ())
113teeAllAny value =
110teeAllAny value =
114− IP.parseD (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
111+ IP.parseD
112+ (PR.teeWith (,)
113+ (drainWhile (<= value))
114+ (drainWhile (<= value))
115+ )
115
116
116{-# INLINE teeFstAllAny #-}
117{-# INLINE teeFstAllAny #-}
117−teeFstAllAny :: (MonadThrow m, Ord a)
118+teeFstAllAny :: MonadThrow m
118− => a -> SerialT m a -> m (Bool, Bool)
119+ => Int -> SerialT m Int -> m ((), ())
119teeFstAllAny value =
120teeFstAllAny value =
121+ IP.parseD
120− IP.parseD (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
122+ (PR.teeWithFst (,)
123+ (drainWhile (<= value))
124+ (drainWhile (<= value))
125+ )
121
126
122{-# INLINE shortestAllAny #-}
127{-# INLINE shortestAllAny #-}
123−shortestAllAny :: (MonadThrow m, Ord a)
128+shortestAllAny :: MonadThrow m
124− => a -> SerialT m a -> m Bool
129+ => Int -> SerialT m Int -> m ()
125shortestAllAny value =
130shortestAllAny value =
131+ IP.parseD
126− IP.parseD (PR.shortest (PR.all (<= value)) (PR.any (> value)))
132+ (PR.shortest
133+ (drainWhile (<= value))
134+ (drainWhile (<= value))
135+ )
127
136
128{-# INLINE longestAllAny #-}
137{-# INLINE longestAllAny #-}
129−longestAllAny :: (MonadCatch m, Ord a)
138+longestAllAny :: MonadCatch m
130− => a -> SerialT m a -> m Bool
139+ => Int -> SerialT m Int -> m ()
131longestAllAny value =
140longestAllAny value =
132− IP.parseD (PR.longest (PR.all (<= value)) (PR.any (> value)))
141+ IP.parseD
142+ (PR.longest
143+ (drainWhile (<= value))
144+ (drainWhile (<= value))
145+ )
133
146
134-------------------------------------------------------------------------------
147-------------------------------------------------------------------------------
135-- Parsers in which -fspec-constr-recursive=16 is problematic
148-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -142,7 +155,7 @@ longestAllAny value =
142{-# INLINE lookAhead #-}
155{-# INLINE lookAhead #-}
143lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
156lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
144lookAhead value =
157lookAhead value =
145− IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
158+ IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
146
159
147{-# INLINE sequenceA_ #-}
160{-# INLINE sequenceA_ #-}
148sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
161sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
@@ -181,10 +194,7 @@ moduleName = "Data.Parser.ParserD"
181
194
182o_1_space_serial :: Int -> [Benchmark]
195o_1_space_serial :: Int -> [Benchmark]
183o_1_space_serial value =
196o_1_space_serial value =
184− [ benchIOSink value "any" $ any value
185− , benchIOSink value "all" $ all value
186− , benchIOSink value "take" $ take value
187− , benchIOSink value "takeWhile" $ takeWhile value
197+ [ benchIOSink value "takeWhile" $ takeWhile value
188 , benchIOSink value "split (all,any)" $ splitAllAny value
198 , benchIOSink value "split (all,any)" $ splitAllAny value
189 , benchIOSink value "many" many
199 , benchIOSink value "many" many
190 , benchIOSink value "some" some
200 , benchIOSink value "some" some
@@ -228,16 +238,7 @@ main = do
228 where
238 where
229
239
230 allBenchmarks value =
240 allBenchmarks value =
231− [ bgroup (o_1_space_prefix moduleName) $ concat
241+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
232− [
233− o_1_space_serial value
234− ]
235− , bgroup (o_n_heap_prefix moduleName) $ concat
242+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
236− [
237− o_n_heap_serial value
238− ]
239− , bgroup (o_n_space_prefix moduleName) $ concat
243+ , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
240− [
241− o_n_space_serial value
242− ]
243 ]
244 ]
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+5−36
@@ -69,30 +69,6 @@ benchIOSink value name f =
69satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
69satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
70satisfy = PR.toParserK . PRD.satisfy
70satisfy = PR.toParserK . PRD.satisfy
71
71
72−{-# INLINE any #-}
73−any :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
74−any = PR.toParserK . PRD.any
75−
76−{-# INLINE anyK #-}
77−anyK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
78−anyK value = PARSE_OP (any (> value))
79−
80−{-# INLINE all #-}
81−all :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
82−all = PR.toParserK . PRD.all
83−
84−{-# INLINE allK #-}
85−allK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
86−allK value = PARSE_OP (all (<= value))
87−
88−{-# INLINE take #-}
89−take :: MonadCatch m => Int -> PR.Parser m a ()
90−take value = PR.toParserK $ PRD.take value FL.drain
91−
92−{-# INLINE takeK #-}
93−takeK :: MonadCatch m => Int -> SerialT m a -> m ()
94−takeK value = PARSE_OP (take value)
95−
96{-# INLINE takeWhile #-}
72{-# INLINE takeWhile #-}
97takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
73takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
98takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
74takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
@@ -103,9 +79,9 @@ takeWhileK value = PARSE_OP (takeWhile (<= value))
103
79
104{-# INLINE splitApp #-}
80{-# INLINE splitApp #-}
105splitApp :: MonadCatch m
81splitApp :: MonadCatch m
106− => Int -> SerialT m Int -> m (Bool, Bool)
82+ => Int -> SerialT m Int -> m ((), ())
107splitApp value =
83splitApp value =
108− PARSE_OP ((,) <$> any (>= (value `div` 2)) <*> any (> value))
84+ PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))
109
85
110{-# INLINE sequenceA #-}
86{-# INLINE sequenceA #-}
111sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
87sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
@@ -157,10 +133,7 @@ moduleName = "Data.Parser.ParserK"
157
133
158o_1_space_serial :: Int -> [Benchmark]
134o_1_space_serial :: Int -> [Benchmark]
159o_1_space_serial value =
135o_1_space_serial value =
160− [ benchIOSink value "any" $ anyK value
161− , benchIOSink value "all" $ allK value
162− , benchIOSink value "take" $ takeK value
163− , benchIOSink value "takeWhile" $ takeWhileK value
136+ [ benchIOSink value "takeWhile" $ takeWhileK value
164 , benchIOSink value "splitApp" $ splitApp value
137 , benchIOSink value "splitApp" $ splitApp value
165 ]
138 ]
166
139
@@ -187,10 +160,6 @@ main = do
187 where
160 where
188
161
189 allBenchmarks value =
162 allBenchmarks value =
190− [ bgroup (o_1_space_prefix moduleName) $ concat
163+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
191− [ o_1_space_serial value
192− ]
193− , bgroup (o_n_heap_prefix moduleName) $ concat
164+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
194− [ o_n_heap_serial value
195− ]
196 ]
165 ]
src/Streamly/Internal/Data/Parser.hs+45−178
@@ -54,8 +54,6 @@ module Streamly.Internal.Data.Parser
54 -- First order parsers
54 -- First order parsers
55 -- * Accumulators
55 -- * Accumulators
56 , fromFold
56 , fromFold
57− , any
58− , all
59 , yield
57 , yield
60 , yieldM
58 , yieldM
61 , die
59 , die
@@ -75,8 +73,7 @@ module Streamly.Internal.Data.Parser
75
73
76 -- | Grab a sequence of input elements without inspecting them
74 -- | Grab a sequence of input elements without inspecting them
77 , takeBetween
75 , takeBetween
78− , take -- takeBetween 0 n
76+ -- , take -- takeBetween 0 n
79− -- $take
80 , takeEQ -- takeBetween n n
77 , takeEQ -- takeBetween n n
81 , takeGE -- takeBetween n maxBound
78 , takeGE -- takeBetween n maxBound
82
79
@@ -86,11 +83,9 @@ module Streamly.Internal.Data.Parser
86 , takeWhile
83 , takeWhile
87 -- $takeWhile
84 -- $takeWhile
88 , takeWhile1
85 , takeWhile1
86+ , drainWhile
89
87
90− , sliceSepByP
91 , sliceSepBy
88 , sliceSepBy
92− , sliceSepByMax
93− , sliceEndWith
94 , sliceBeginWith
89 , sliceBeginWith
95 , sliceSepWith
90 , sliceSepWith
96 , escapedSliceSepBy
91 , escapedSliceSepBy
@@ -134,7 +129,7 @@ module Streamly.Internal.Data.Parser
134
129
135 -- * N-ary Combinators
130 -- * N-ary Combinators
136 -- ** Sequential Collection
131 -- ** Sequential Collection
137− , sequence
132+ , concatSequence
138 , concatMap
133 , concatMap
139
134
140 -- ** Sequential Repetition
135 -- ** Sequential Repetition
@@ -206,6 +201,7 @@ import Prelude
206import Streamly.Internal.Data.Fold.Types (Fold(..))
201import Streamly.Internal.Data.Fold.Types (Fold(..))
207import Streamly.Internal.Data.Parser.ParserK.Types (Parser)
202import Streamly.Internal.Data.Parser.ParserK.Types (Parser)
208
203
204+import qualified Streamly.Internal.Data.Fold as FL
209import qualified Streamly.Internal.Data.Parser.ParserD as D
205import qualified Streamly.Internal.Data.Parser.ParserD as D
210import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
206import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
211
207
@@ -225,22 +221,6 @@ fromFold = K.toParserK . D.fromFold
225-- Terminating but not failing folds
221-- Terminating but not failing folds
226-------------------------------------------------------------------------------
222-------------------------------------------------------------------------------
227--
223--
228−-- |
229−-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
230−-- > True
231−--
232−{-# INLINE any #-}
233−any :: MonadCatch m => (a -> Bool) -> Parser m a Bool
234−any = K.toParserK . D.any
235−
236−-- |
237−-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
238−-- > False
239−--
240−{-# INLINE all #-}
241−all :: MonadCatch m => (a -> Bool) -> Parser m a Bool
242−all = K.toParserK . D.all
243−
244-- This is the dual of stream "yield".
224-- This is the dual of stream "yield".
245--
225--
246-- | A parser that always yields a pure value without consuming any input.
226-- | A parser that always yields a pure value without consuming any input.
@@ -377,35 +357,6 @@ takeBetween :: -- MonadCatch m =>
377 Int -> Int -> Fold m a b -> Parser m a b
357 Int -> Int -> Fold m a b -> Parser m a b
378takeBetween _m _n = undefined -- K.toParserK . D.takeBetween m n
358takeBetween _m _n = undefined -- K.toParserK . D.takeBetween m n
379
359
380−--
381−-- $take
382−-- Note: this is called takeP in some parser libraries.
383−--
384−-- TODO Once we have terminating folds, this Parse should get replaced by Fold.
385−-- Alternatively, we can name it "chunkOf" and the corresponding time domain
386−-- combinator as "intervalOf" or even "chunk" and "interval".
387−
388−-- | Take at most @n@ input elements and fold them using the supplied fold.
389−--
390−-- Stops after @n@ elements.
391−-- Never fails.
392−--
393−-- >>> S.parse (PR.take 1 FL.toList) $ S.fromList [1]
394−-- [1]
395−--
396−-- >>> S.parse (PR.take (-1) FL.toList) $ S.fromList [1]
397−-- []
398−--
399−-- @
400−-- S.chunksOf n f = S.parseMany (FL.take n f)
401−-- @
402−--
403−-- /Internal/
404−--
405−{-# INLINE take #-}
406−take :: MonadCatch m => Int -> Fold m a b -> Parser m a b
407−take n = K.toParserK . D.take n
408−
409-- | Stops after taking exactly @n@ input elements.
360-- | Stops after taking exactly @n@ input elements.
410--
361--
411-- * Stops - after consuming @n@ elements.
362-- * Stops - after consuming @n@ elements.
@@ -423,8 +374,9 @@ takeEQ n = K.toParserK . D.takeEQ n
423
374
424-- | Take at least @n@ input elements, but can collect more.
375-- | Take at least @n@ input elements, but can collect more.
425--
376--
426−-- * Stops - never.
377+-- * Stops - when the collecting fold stops.
427−-- * Fails - if the stream end before producing @n@ elements.
378+-- * Fails - if the stream or the collecting fold ends before producing @n@
379+-- elements.
428--
380--
429-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1]
381-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1]
430-- > "takeGE: Expecting at least 4 elements, got only 3"
382-- > "takeGE: Expecting at least 4 elements, got only 3"
@@ -465,7 +417,7 @@ takeWhileP _cond = undefined -- K.toParserK . D.takeWhileP cond
465-- | Collect stream elements until an element fails the predicate. The element
417-- | Collect stream elements until an element fails the predicate. The element
466-- on which the predicate fails is returned back to the input stream.
418-- on which the predicate fails is returned back to the input stream.
467--
419--
468−-- * Stops - when the predicate fails.
420+-- * Stops - when the predicate fails or the collecting fold stops.
469-- * Fails - never.
421-- * Fails - never.
470--
422--
471-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
423-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
@@ -491,9 +443,19 @@ takeWhile cond = K.toParserK . D.takeWhile cond
491takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
443takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
492takeWhile1 cond = K.toParserK . D.takeWhile1 cond
444takeWhile1 cond = K.toParserK . D.takeWhile1 cond
493
445
494−-- | Like 'sliceSepBy' but uses a 'Parser' instead of a 'Fold' to collect the
446+-- | Drain the input as long as the predicate succeeds, running the effects and
447+-- discarding the results.
448+--
449+-- This is also called @skipWhile@ in some parsing libraries.
450+--
451+-- /Internal/
452+--
453+{-# INLINE drainWhile #-}
454+drainWhile :: MonadCatch m => (a -> Bool) -> Parser m a ()
455+drainWhile p = takeWhile p FL.drain
456+
495−-- input. @sliceSepByP cond parser@ parses a slice of the input using @parser@
457+-- | @sliceSepBy cond parser@ parses a slice of the input using @parser@ until
496−-- until @cond@ succeeds or the parser stops.
458+-- @cond@ succeeds or the parser stops.
497--
459--
498-- This is a generalized slicing parser which can be used to implement other
460-- This is a generalized slicing parser which can be used to implement other
499-- parsers e.g.:
461-- parsers e.g.:
@@ -505,59 +467,10 @@ takeWhile1 cond = K.toParserK . D.takeWhile1 cond
505--
467--
506-- /Unimplemented/
468-- /Unimplemented/
507--
469--
508−{-# INLINABLE sliceSepByP #-}
509−sliceSepByP :: -- MonadCatch m =>
510− (a -> Bool) -> Parser m a b -> Parser m a b
511−sliceSepByP _cond = undefined -- K.toParserK . D.sliceSepByP cond
512−
513−-- Note: Keep this consistent with S.splitOn. In fact we should eliminate
514−-- S.splitOn in favor of the parser.
515−--
516−-- | Split on an infixed separator element, dropping the separator. Splits the
517−-- stream on separator elements determined by the supplied predicate, separator
518−-- is considered as infixed between two segments, if one side of the separator
519−-- is missing then it is parsed as an empty stream. The supplied 'Fold' is
520−-- applied on the split segments. With '-' representing non-separator elements
521−-- and '.' as separator, 'splitOn' splits as follows:
522−--
523−-- @
524−-- "--.--" => "--" "--"
525−-- "--." => "--" ""
526−-- ".--" => "" "--"
527−-- @
528−--
529−-- @PR.sliceSepBy (== x)@ is an inverse of @S.intercalate (S.yield x)@
530−--
531−-- Let's use the following definition for illustration:
532−--
533−-- > splitOn p = PR.many FL.toList $ PR.sliceSepBy p (FL.toList)
534−-- > splitOn' p = S.parse (splitOn p) . S.fromList
535−--
536−-- >>> splitOn' (== '.') ""
537−-- [""]
538−--
539−-- >>> splitOn' (== '.') "."
540−-- ["",""]
541−--
542−-- >>> splitOn' (== '.') ".a"
543−-- > ["","a"]
544−--
545−-- >>> splitOn' (== '.') "a."
546−-- > ["a",""]
547−--
548−-- >>> splitOn' (== '.') "a.b"
549−-- > ["a","b"]
550−--
551−-- >>> splitOn' (== '.') "a..b"
552−-- > ["a","","b"]
553−--
554−-- * Stops - when the predicate succeeds.
555−-- * Fails - never.
556−--
557−-- /Internal/
558{-# INLINABLE sliceSepBy #-}
470{-# INLINABLE sliceSepBy #-}
559−sliceSepBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
471+sliceSepBy :: -- MonadCatch m =>
472+ (a -> Bool) -> Parser m a b -> Parser m a b
560−sliceSepBy cond = K.toParserK . D.sliceSepBy cond
473+sliceSepBy _cond = undefined -- K.toParserK . D.sliceSepBy cond
561
474
562-- | Like 'sliceSepBy' but does not drop the separator element, instead
475-- | Like 'sliceSepBy' but does not drop the separator element, instead
563-- separator is emitted as a separate element in the output.
476-- separator is emitted as a separate element in the output.
@@ -568,23 +481,6 @@ sliceSepWith :: -- MonadCatch m =>
568 (a -> Bool) -> Fold m a b -> Parser m a b
481 (a -> Bool) -> Fold m a b -> Parser m a b
569sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond
482sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond
570
483
571−-- | Collect stream elements until an element succeeds the predicate. Also take
572−-- the element on which the predicate succeeded. The succeeding element is
573−-- treated as a suffix separator which is kept in the output segement.
574−--
575−-- * Stops - when the predicate succeeds.
576−-- * Fails - never.
577−--
578−-- S.splitWithSuffix pred f = S.parseMany (PR.sliceEndWith pred f)
579−--
580−-- /Unimplemented/
581−--
582−{-# INLINABLE sliceEndWith #-}
583−sliceEndWith ::
584− -- Monad m =>
585− (a -> Bool) -> Fold m a b -> Parser m a b
586−sliceEndWith = undefined
587−
588-- | Collect stream elements until an elements passes the predicate, return the
484-- | Collect stream elements until an elements passes the predicate, return the
589-- last element on which the predicate succeeded back to the input stream. If
485-- last element on which the predicate succeeded back to the input stream. If
590-- the predicate succeeds on the first element itself then it is kept in the
486-- the predicate succeeds on the first element itself then it is kept in the
@@ -604,44 +500,6 @@ sliceBeginWith ::
604 (a -> Bool) -> Fold m a b -> Parser m a b
500 (a -> Bool) -> Fold m a b -> Parser m a b
605sliceBeginWith = undefined
501sliceBeginWith = undefined
606
502
607−-- | Like 'sliceSepBy' but terminates a parse even before the separator
608−-- is encountered if its size exceeds the specified maximum limit.
609−--
610−-- > take n = PR.sliceSepByMax (const True) n
611−-- > sliceSepBy p = PR.sliceSepByMax p maxBound
612−--
613−-- Let's use the following definitions for illustration:
614−--
615−-- > splitOn p n = PR.many FL.toList $ PR.sliceSepByMax p n (FL.toList)
616−-- > splitOn' p n = S.parse (splitOn p n) . S.fromList
617−--
618−-- >>> splitOn' (== '.') 0 ""
619−-- [""]
620−--
621−-- >>> splitOn' (== '.') 0 "a"
622−-- infinite list of empty strings
623−--
624−-- >>> splitOn' (== '.') 3 "hello.world"
625−-- ["hel","lo","wor","ld"]
626−--
627−-- If the separator is found and the limit is reached at the same time then it
628−-- behaves just like 'sliceSepBy' i.e. the separator is dropped.
629−--
630−-- >>> splitOn' (== '.') 0 "."
631−-- ["",""]
632−--
633−-- >>> splitOn' (== '.') 0 ".."
634−-- ["","",""]
635−--
636−-- * Stops - when the predicate succeeds or the limit is reached.
637−-- * Fails - never.
638−--
639−-- /Internal/
640−{-# INLINABLE sliceSepByMax #-}
641−sliceSepByMax :: MonadCatch m
642− => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
643−sliceSepByMax cond cnt = K.toParserK . D.sliceSepByMax cond cnt
644−
645-- | Like 'sliceSepBy' but the separator elements can be escaped using an
503-- | Like 'sliceSepBy' but the separator elements can be escaped using an
646-- escape char determined by the second predicate.
504-- escape char determined by the second predicate.
647--
505--
@@ -911,18 +769,19 @@ deintercalate = undefined
911-- Sequential Collection
769-- Sequential Collection
912-------------------------------------------------------------------------------
770-------------------------------------------------------------------------------
913--
771--
914−-- | @sequence f t@ collects sequential parses of parsers in the container @t@
772+-- | @concatSequence f t@ collects sequential parses of parsers in the
915−-- using the fold @f@. Fails if the input ends or any of the parsers fail.
773+-- container @t@ using the fold @f@. Fails if the input ends or any of the
774+-- parsers fail.
916--
775--
917-- This is same as 'Data.Traversable.sequence' but more efficient.
776-- This is same as 'Data.Traversable.sequence' but more efficient.
918--
777--
919-- /Unimplemented/
778-- /Unimplemented/
920--
779--
921−{-# INLINE sequence #-}
780+{-# INLINE concatSequence #-}
922−sequence ::
781+concatSequence ::
923 -- Foldable t =>
782 -- Foldable t =>
924 Fold m b c -> t (Parser m a b) -> Parser m a c
783 Fold m b c -> t (Parser m a b) -> Parser m a c
925−sequence _f _p = undefined
784+concatSequence _f _p = undefined
926
785
927-- | Map a 'Parser' returning function on the result of a 'Parser'.
786-- | Map a 'Parser' returning function on the result of a 'Parser'.
928--
787--
@@ -974,10 +833,11 @@ manyP :: -- MonadCatch m =>
974 Parser m b c -> Parser m a b -> Parser m a c
833 Parser m b c -> Parser m a b -> Parser m a c
975manyP _f _p = undefined -- K.toParserK $ D.manyP f (K.fromParserK p)
834manyP _f _p = undefined -- K.toParserK $ D.manyP f (K.fromParserK p)
976
835
977−-- | Collect zero or more parses. Apply the parser repeatedly on the input
836+-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
978−-- stream, stop when the parser fails, accumulate zero or more parse results
837+-- input stream and push the parse results to a downstream fold.
979−-- using the supplied 'Fold'. This parser never fails, in case the first
838+--
980−-- application of parser fails it returns an empty result.
839+-- Stops: when the downstream fold stops or the parser fails.
840+-- Fails: never, produces zero or more results.
981--
841--
982-- Compare with 'Control.Applicative.many'.
842-- Compare with 'Control.Applicative.many'.
983--
843--
@@ -988,10 +848,15 @@ many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
988many f p = K.toParserK $ D.many f (K.fromParserK p)
848many f p = K.toParserK $ D.many f (K.fromParserK p)
989-- many = countBetween 0 maxBound
849-- many = countBetween 0 maxBound
990
850
851+-- Note: many1 would perhaps be a better name for this and consistent with
852+-- other names like takeWhile1. But we retain the name "some" for
853+-- compatibility.
854+--
991-- | Collect one or more parses. Apply the supplied parser repeatedly on the
855-- | Collect one or more parses. Apply the supplied parser repeatedly on the
992−-- input stream and accumulate the parse results as long as the parser
856+-- input stream and push the parse results to a downstream fold.
993−-- succeeds, stop when it fails. This parser fails if not even one result is
857+--
994−-- collected.
858+-- Stops: when the downstream fold stops or the parser fails.
859+-- Fails: if it stops without producing a single result.
995--
860--
996-- @some fld parser = many (takeGE 1 fld) parser@
861-- @some fld parser = many (takeGE 1 fld) parser@
997--
862--
@@ -1054,6 +919,8 @@ manyTillP _f _p1 _p2 = undefined
1054-- @test@ is discarded and the output of @collect@ is accumulated by the
919-- @test@ is discarded and the output of @collect@ is accumulated by the
1055-- supplied fold. The parser fails if @collect@ fails.
920-- supplied fold. The parser fails if @collect@ fails.
1056--
921--
922+-- Stops when the fold @f@ stops.
923+--
1057-- /Internal/
924-- /Internal/
1058--
925--
1059{-# INLINE manyTill #-}
926{-# INLINE manyTill #-}
src/Streamly/Internal/Data/Parser/ParserD.hs+14−63
@@ -19,8 +19,6 @@ module Streamly.Internal.Data.Parser.ParserD
19 -- First order parsers
19 -- First order parsers
20 -- * Accumulators
20 -- * Accumulators
21 , fromFold
21 , fromFold
22− , any
23− , all
24 , yield
22 , yield
25 , yieldM
23 , yieldM
26 , die
24 , die
@@ -45,7 +43,6 @@ module Streamly.Internal.Data.Parser.ParserD
45 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
43 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
46 --
44 --
47 -- Grab a sequence of input elements without inspecting them
45 -- Grab a sequence of input elements without inspecting them
48− , take
49 -- , takeBetween
46 -- , takeBetween
50 -- , takeLE -- take -- takeBetween 0 n
47 -- , takeLE -- take -- takeBetween 0 n
51 -- , takeLE1 -- take1 -- takeBetween 1 n
48 -- , takeLE1 -- take1 -- takeBetween 1 n
@@ -57,9 +54,7 @@ module Streamly.Internal.Data.Parser.ParserD
57 , takeWhile
54 , takeWhile
58 , takeWhile1
55 , takeWhile1
59 , sliceSepBy
56 , sliceSepBy
60− , sliceSepByMax
61 -- , sliceSepByBetween
57 -- , sliceSepByBetween
62− , sliceEndWith
63 , sliceBeginWith
58 , sliceBeginWith
64 -- , sliceSepWith
59 -- , sliceSepWith
65 --
60 --
@@ -164,7 +159,6 @@ import Streamly.Internal.Data.Fold.Types (Fold(..))
164import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
159import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
165
160
166import qualified Streamly.Internal.Data.Fold.Types as FL
161import qualified Streamly.Internal.Data.Fold.Types as FL
167−import qualified Streamly.Internal.Data.Fold as FL
168
162
169import Prelude hiding
163import Prelude hiding
170 (any, all, take, takeWhile, sequence, concatMap, maybe, either)
164 (any, all, take, takeWhile, sequence, concatMap, maybe, either)
@@ -192,19 +186,6 @@ fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
192 FL.Partial s1 -> Partial 0 s1
186 FL.Partial s1 -> Partial 0 s1
193 FL.Done b -> Done 0 b
187 FL.Done b -> Done 0 b
194
188
195−
196−-------------------------------------------------------------------------------
197−-- Terminating but not failing folds
198−-------------------------------------------------------------------------------
199−--
200−{-# INLINE any #-}
201−any :: Monad m => (a -> Bool) -> Parser m a Bool
202−any predicate = fromFold $ FL.any predicate
203−
204−{-# INLINABLE all #-}
205−all :: Monad m => (a -> Bool) -> Parser m a Bool
206−all predicate = fromFold $ FL.all predicate
207−
208-------------------------------------------------------------------------------
189-------------------------------------------------------------------------------
209-- Failing Parsers
190-- Failing Parsers
210-------------------------------------------------------------------------------
191-------------------------------------------------------------------------------
@@ -300,16 +281,6 @@ either parser = Parser step initial extract
300-- Taking elements
281-- Taking elements
301-------------------------------------------------------------------------------
282-------------------------------------------------------------------------------
302
283
303−-- It will be inconsistent with other takeish combinators.
304−-- This is takeLE
305−-- | See 'Streamly.Internal.Data.Parser.take'.
306−--
307−-- /Internal/
308−--
309−{-# INLINE take #-}
310−take :: Monad m => Int -> Fold m a b -> Parser m a b
311−take n fld = fromFold $ FL.ltake n fld
312−
313-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
284-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
314--
285--
315-- /Internal/
286-- /Internal/
@@ -340,6 +311,7 @@ takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract
340 <$> case res of
311 <$> case res of
341 FL.Partial s -> fextract s
312 FL.Partial s -> fextract s
342 FL.Done b -> return b
313 FL.Done b -> return b
314+ -- XXX we should not reach here when initial returns Step type
343 -- reachable only when n == 0
315 -- reachable only when n == 0
344 | otherwise = Done 1 <$> fextract r
316 | otherwise = Done 1 <$> fextract r
345
317
@@ -420,7 +392,6 @@ takeWhile predicate (Fold fstep finitial fextract) =
420 FL.Done b -> Done 0 b
392 FL.Done b -> Done 0 b
421 else Done 1 <$> fextract s
393 else Done 1 <$> fextract s
422
394
423−
424-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
395-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
425--
396--
426-- /Internal/
397-- /Internal/
@@ -443,7 +414,7 @@ takeWhile1 predicate (Fold fstep finitial fextract) =
443 $ case sr of
414 $ case sr of
444 FL.Partial r -> Partial 0 (Just r)
415 FL.Partial r -> Partial 0 (Just r)
445 FL.Done b -> Done 0 b
416 FL.Done b -> Done 0 b
446− else return $ Error err
417+ else return $ Error "takeWhile1: predicate failed on first element"
447 step (Just s) a =
418 step (Just s) a =
448 if predicate a
419 if predicate a
449 then do
420 then do
@@ -455,28 +426,16 @@ takeWhile1 predicate (Fold fstep finitial fextract) =
455 b <- fextract s
426 b <- fextract s
456 return $ Done 1 b
427 return $ Done 1 b
457
428
458− extract Nothing = throwM $ ParseError err
429+ extract Nothing = throwM $ ParseError "takeWhile1: end of input"
459 extract (Just s) = fextract s
430 extract (Just s) = fextract s
460
431
461− err = "takeWhile1: end of input"
462−
463-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
432-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
464--
433--
465-- /Internal/
434-- /Internal/
466--
435--
467−{-# INLINABLE sliceSepBy #-}
436+sliceSepBy :: -- MonadCatch m =>
468−sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
469−sliceSepBy predicate fld = fromFold $ FL.sliceSepBy predicate fld
470−
471−-- | See 'Streamly.Internal.Data.Parser.sliceEndWith'.
472−--
473−-- /Unimplemented/
474−--
475−{-# INLINABLE sliceEndWith #-}
476−sliceEndWith ::
477− -- Monad m =>
478− (a -> Bool) -> Fold m a b -> Parser m a b
437+ (a -> Bool) -> Parser m a b -> Parser m a b
479−sliceEndWith = undefined
438+sliceSepBy _cond = undefined
480
439
481-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
440-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
482--
441--
@@ -488,15 +447,6 @@ sliceBeginWith ::
488 (a -> Bool) -> Fold m a b -> Parser m a b
447 (a -> Bool) -> Fold m a b -> Parser m a b
489sliceBeginWith = undefined
448sliceBeginWith = undefined
490
449
491−-- | See 'Streamly.Internal.Data.Parser.sliceSepByMax'.
492−--
493−-- /Internal/
494−--
495−{-# INLINABLE sliceSepByMax #-}
496−sliceSepByMax :: Monad m
497− => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
498−sliceSepByMax p n = sliceSepBy p . FL.ltake n
499−
500-- | See 'Streamly.Internal.Data.Parser.wordBy'.
450-- | See 'Streamly.Internal.Data.Parser.wordBy'.
501--
451--
502-- /Unimplemented/
452-- /Unimplemented/
@@ -709,6 +659,7 @@ manyTill (Fold fstep finitial fextract)
709 Error _ -> do
659 Error _ -> do
710 rR <- initialL
660 rR <- initialL
711 return $ Continue (cnt + 1) (ManyTillL 0 fs rR)
661 return $ Continue (cnt + 1) (ManyTillL 0 fs rR)
662+ -- XXX the cnt is being used only by the assert
712 step (ManyTillL cnt fs st) a = do
663 step (ManyTillL cnt fs st) a = do
713 r <- stepL st a
664 r <- stepL st a
714 case r of
665 case r of
@@ -717,17 +668,17 @@ manyTill (Fold fstep finitial fextract)
717 assert (cnt + 1 - n >= 0) (return ())
668 assert (cnt + 1 - n >= 0) (return ())
718 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
669 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
719 Done n b -> do
670 Done n b -> do
720− sfs1 <- fstep fs b
671+ fs1 <- fstep fs b
721− case sfs1 of
672+ case fs1 of
722− FL.Partial fs1 -> do
673+ FL.Partial s -> do
723 l <- initialR
674 l <- initialR
724− return $ Partial n (ManyTillR 0 fs1 l)
675+ return $ Partial n (ManyTillR 0 s l)
725− FL.Done fb -> return $ Done n fb
676+ FL.Done b1 -> return $ Done n b1
726 Error err -> return $ Error err
677 Error err -> return $ Error err
727
678
728 extract (ManyTillL _ fs sR) = do
679 extract (ManyTillL _ fs sR) = do
729 res <- extractL sR >>= fstep fs
680 res <- extractL sR >>= fstep fs
730 case res of
681 case res of
731− FL.Partial sres -> fextract sres
682+ FL.Partial s -> fextract s
732− FL.Done bres -> return bres
683+ FL.Done b -> return b
733 extract (ManyTillR _ fs _) = fextract fs
684 extract (ManyTillR _ fs _) = fextract fs
src/Streamly/Internal/Data/Parser/ParserD/Types.hs+7−11
@@ -122,8 +122,8 @@ module Streamly.Internal.Data.Parser.ParserD.Types
122
122
123 , die
123 , die
124 , dieM
124 , dieM
125− , splitSome
125+ , splitSome -- parseSome?
126− , splitMany
126+ , splitMany -- parseMany?
127 , alt
127 , alt
128 , concatMap
128 , concatMap
129 )
129 )
@@ -274,6 +274,8 @@ yieldM b = Parser (\_ _ -> Done 1 <$> b) -- step
274{-# ANN type SeqParseState Fuse #-}
274{-# ANN type SeqParseState Fuse #-}
275data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
275data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
276
276
277+-- | See 'Streamly.Internal.Data.Parser.splitWith'.
278+--
277-- Note: this implementation of splitWith is fast because of stream fusion but
279-- Note: this implementation of splitWith is fast because of stream fusion but
278-- has quadratic time complexity, because each composition adds a new branch
280-- has quadratic time complexity, because each composition adds a new branch
279-- that each subsequent parse's input element has to go through, therefore, it
281-- that each subsequent parse's input element has to go through, therefore, it
@@ -281,8 +283,6 @@ data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
281-- compositions the performance starts dipping rapidly beyond a CPS style
283-- compositions the performance starts dipping rapidly beyond a CPS style
282-- unfused implementation.
284-- unfused implementation.
283--
285--
284−-- | See 'Streamly.Internal.Data.Parser.splitWith'.
285−--
286-- /Internal/
286-- /Internal/
287--
287--
288{-# INLINE splitWith #-}
288{-# INLINE splitWith #-}
@@ -430,7 +430,6 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
430 extract (AltParseR sR) = extractR sR
430 extract (AltParseR sR) = extractR sR
431 extract (AltParseL _ sL) = extractL sL
431 extract (AltParseL _ sL) = extractL sL
432
432
433−-- XXX We are ignoring the Error?
434-- | See documentation of 'Streamly.Internal.Data.Parser.many'.
433-- | See documentation of 'Streamly.Internal.Data.Parser.many'.
435--
434--
436-- /Internal/
435-- /Internal/
@@ -453,17 +452,14 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
453 let cnt1 = cnt + 1
452 let cnt1 = cnt + 1
454 case r of
453 case r of
455 Partial n s -> do
454 Partial n s -> do
456− -- XXX Combine assert with the next statement
457 assert (cnt1 - n >= 0) (return ())
455 assert (cnt1 - n >= 0) (return ())
458 return $ Continue n (Tuple3' s (cnt1 - n) fs)
456 return $ Continue n (Tuple3' s (cnt1 - n) fs)
459 Continue n s -> do
457 Continue n s -> do
460− -- XXX Combine assert with the next statement
461 assert (cnt1 - n >= 0) (return ())
458 assert (cnt1 - n >= 0) (return ())
462 return $ Continue n (Tuple3' s (cnt1 - n) fs)
459 return $ Continue n (Tuple3' s (cnt1 - n) fs)
463 Done n b -> do
460 Done n b -> do
464 s <- initial1
461 s <- initial1
465 fs1 <- fstep fs b
462 fs1 <- fstep fs b
466− -- XXX Combine assert with the next statement
467 assert (cnt1 - n >= 0) (return ())
463 assert (cnt1 - n >= 0) (return ())
468 return
464 return
469 $ case fs1 of
465 $ case fs1 of
@@ -484,8 +480,6 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
484 FL.Partial s1 -> fextract s1
480 FL.Partial s1 -> fextract s1
485 FL.Done b1 -> return b1
481 FL.Done b1 -> return b1
486
482
487−-- XXX Unwrap Either into their own constructors?
488−-- XXX I think haskell automatically does this though. Need to check.
489-- | See documentation of 'Streamly.Internal.Data.Parser.some'.
483-- | See documentation of 'Streamly.Internal.Data.Parser.some'.
490--
484--
491-- /Internal/
485-- /Internal/
@@ -505,6 +499,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
505 {-# INLINE step #-}
499 {-# INLINE step #-}
506 step (Tuple3' st cnt (Left fs)) a = do
500 step (Tuple3' st cnt (Left fs)) a = do
507 r <- step1 st a
501 r <- step1 st a
502+ -- In the Left state, count is used only for the assert
508 let cnt1 = cnt + 1
503 let cnt1 = cnt + 1
509 case r of
504 case r of
510 Partial n s -> do
505 Partial n s -> do
@@ -514,6 +509,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
514 assert (cnt1 - n >= 0) (return ())
509 assert (cnt1 - n >= 0) (return ())
515 return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))
510 return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))
516 Done n b -> do
511 Done n b -> do
512+ assert (cnt1 - n >= 0) (return ())
517 s <- initial1
513 s <- initial1
518 fs1 <- fstep fs b
514 fs1 <- fstep fs b
519 return
515 return
@@ -532,9 +528,9 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
532 assert (cnt1 - n >= 0) (return ())
528 assert (cnt1 - n >= 0) (return ())
533 return $ Continue n (Tuple3' s (cnt1 - n) (Right fs))
529 return $ Continue n (Tuple3' s (cnt1 - n) (Right fs))
534 Done n b -> do
530 Done n b -> do
531+ assert (cnt1 - n >= 0) (return ())
535 s <- initial1
532 s <- initial1
536 fs1 <- fstep fs b
533 fs1 <- fstep fs b
537− assert (cnt1 - n >= 0) (return ())
538 return
534 return
539 $ case fs1 of
535 $ case fs1 of
540 FL.Partial s1 -> Partial n (Tuple3' s 0 (Right s1))
536 FL.Partial s1 -> Partial n (Tuple3' s 0 (Right s1))
src/Streamly/Internal/FileSystem/Event/Linux.hs+3−1
@@ -783,7 +783,9 @@ readOneEvent cfg wt@(Watch _ wdMap) = do
783 -- XXX sliceSepByMax drops the separator so assumes a null
783 -- XXX sliceSepByMax drops the separator so assumes a null
784 -- terminated path, we should use a takeWhile nested inside a
784 -- terminated path, we should use a takeWhile nested inside a
785 -- takeP
785 -- takeP
786+ pth <-
787+ PR.fromFold
786− pth <- PR.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
788+ $ FL.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
787 let remaining = pathLen - A.length pth - 1
789 let remaining = pathLen - A.length pth - 1
788 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
790 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
789 return pth
791 return pth
streamly.cabal+2
@@ -694,11 +694,13 @@ test-suite Data.Parser
694 ghc-options: -O2
694 ghc-options: -O2
695 type: exitcode-stdio-1.0
695 type: exitcode-stdio-1.0
696 main-is: Streamly/Test/Data/Parser.hs
696 main-is: Streamly/Test/Data/Parser.hs
697+ other-modules: Streamly.Test.Common
697
698
698test-suite Data.Parser.ParserD
699test-suite Data.Parser.ParserD
699 import: test-options
700 import: test-options
700 type: exitcode-stdio-1.0
701 type: exitcode-stdio-1.0
701 main-is: Streamly/Test/Data/Parser/ParserD.hs
702 main-is: Streamly/Test/Data/Parser/ParserD.hs
703+ other-modules: Streamly.Test.Common
702
704
703test-suite Data.Array
705test-suite Data.Array
704 import: test-options
706 import: test-options
test/Streamly/Test/Data/Parser.hs+21−94
@@ -1,16 +1,14 @@
1module Main (main) where
1module Main (main) where
2
2
3import Control.Exception (SomeException(..), displayException)
3import Control.Exception (SomeException(..), displayException)
4−import Control.Monad (when)
5−import Control.Monad.IO.Class (MonadIO(..))
6−import Data.List ((\\))
7import Data.Word (Word8, Word32, Word64)
4import Data.Word (Word8, Word32, Word64)
5+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
8import Test.Hspec (Spec, hspec, describe)
6import Test.Hspec (Spec, hspec, describe)
9import Test.Hspec.QuickCheck
7import Test.Hspec.QuickCheck
10import Test.QuickCheck
8import Test.QuickCheck
11− (arbitrary, forAll, choose, elements, Property, property, listOf,
9+ (arbitrary, forAll, elements, Property, property, listOf,
12− vectorOf, counterexample, Gen, suchThat)
10+ vectorOf, Gen, suchThat)
13−import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor, run)
11+import Test.QuickCheck.Monadic (monadicIO, assert, run)
14
12
15import Prelude hiding (sequence)
13import Prelude hiding (sequence)
16
14
@@ -52,30 +50,6 @@ max_value = 10000
52max_length :: Int
50max_length :: Int
53max_length = 1000
51max_length = 1000
54
52
55−listEquals :: (Show a, Eq a, MonadIO m)
56− => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
57−listEquals eq parsed_list list = do
58− when (not $ parsed_list `eq` list) $ liftIO $ putStrLn $
59− "parsed list " ++ show parsed_list
60− ++ "\nlist " ++ show list
61− ++ "\nparsed list \\\\ list " ++ show (parsed_list \\ list)
62− ++ "\nlist \\\\ parsed list " ++ show (list \\ parsed_list)
63− when (not $ parsed_list `eq` list) $
64− monitor
65− (counterexample $
66− "parsed list " ++ show parsed_list
67− ++ "\nlist " ++ show list
68− ++ "\nparsed list \\\\ list " ++ show (parsed_list \\ list)
69− ++ "\nlist \\\\ parsed list " ++ show (list \\ parsed_list)
70− )
71− assert (parsed_list `eq` list)
72−
73−checkListEqual :: (Show a, Eq a) => [a] -> [a] -> Property
74−checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)
75−
76−chooseInt :: (Int, Int) -> Gen Int
77−chooseInt = choose
78−
79-- Accumulator Tests
53-- Accumulator Tests
80
54
81fromFold :: Property
55fromFold :: Property
@@ -85,20 +59,6 @@ fromFold =
85 Right is_equal -> is_equal
59 Right is_equal -> is_equal
86 Left _ -> False
60 Left _ -> False
87
61
88−any :: Property
89−any =
90− forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
91− case S.parse (P.any (> mid_value)) (S.fromList ls) of
92− Right r -> r == (Prelude.any (> mid_value) ls)
93− Left _ -> False
94−
95−all :: Property
96−all =
97− forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
98− case S.parse (P.all (> mid_value)) (S.fromList ls) of
99− Right r -> r == (Prelude.all (> mid_value) ls)
100− Left _ -> False
101−
102yield :: Property
62yield :: Property
103yield =
63yield =
104 forAll (chooseInt (min_value, max_value)) $ \x ->
64 forAll (chooseInt (min_value, max_value)) $ \x ->
@@ -195,14 +155,6 @@ satisfy =
195
155
196-- Sequence Parsers Tests
156-- Sequence Parsers Tests
197
157
198−take :: Property
199−take =
200− forAll (chooseInt (min_value, max_value)) $ \n ->
201− forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
202− case S.parse (P.take n FL.toList) (S.fromList ls) of
203− Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
204− Left _ -> property False
205−
206takeEQPass :: Property
158takeEQPass :: Property
207takeEQPass =
159takeEQPass =
208 forAll (chooseInt (min_value, max_value)) $ \n ->
160 forAll (chooseInt (min_value, max_value)) $ \n ->
@@ -268,8 +220,6 @@ nLessThanEqual0 tk ltk =
268takeProperties :: Spec
220takeProperties :: Spec
269takeProperties =
221takeProperties =
270 describe "take combinators when n <= 0/" $ do
222 describe "take combinators when n <= 0/" $ do
271− prop "take n FL.toList = []" $
272− nLessThanEqual0 P.take (\_ -> const [])
273 prop "takeEQ n FL.toList = []" $
223 prop "takeEQ n FL.toList = []" $
274 nLessThanEqual0 P.takeEQ (\_ -> const [])
224 nLessThanEqual0 P.takeEQ (\_ -> const [])
275 prop "takeGE n FL.toList xs = xs" $
225 prop "takeGE n FL.toList xs = xs" $
@@ -350,25 +300,6 @@ takeWhile1 =
350 where
300 where
351 predicate = (== 0)
301 predicate = (== 0)
352
302
353−sliceSepBy :: Property
354−sliceSepBy =
355− forAll (listOf (chooseInt (0, 1))) $ \ls ->
356− case S.parse (P.sliceSepBy predicate FL.toList) (S.fromList ls) of
357− Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile (not . predicate) ls)
358− Left _ -> property False
359− where
360− predicate = (== 1)
361−
362−sliceSepByMax :: Property
363−sliceSepByMax =
364− forAll (chooseInt (min_value, max_value)) $ \n ->
365− forAll (listOf (chooseInt (0, 1))) $ \ls ->
366− case S.parse (P.sliceSepByMax predicate n FL.toList) (S.fromList ls) of
367− Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
368− Left _ -> property False
369− where
370− predicate = (== 1)
371−
372-- splitWithPass :: Property
303-- splitWithPass :: Property
373-- splitWithPass =
304-- splitWithPass =
374-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
305-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
@@ -474,7 +405,8 @@ many =
474 forAll (listOf (chooseInt (0, 1))) $ \ls ->
405 forAll (listOf (chooseInt (0, 1))) $ \ls ->
475 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
406 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
476 concatFold = FL.Fold fldstp (return []) return
407 concatFold = FL.Fold fldstp (return []) return
477− prsr = P.many concatFold $ P.sliceSepBy (== 1) FL.toList
408+ prsr = P.many concatFold
409+ $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList
478 in
410 in
479 case S.parse prsr (S.fromList ls) of
411 case S.parse prsr (S.fromList ls) of
480 Right res_list -> checkListEqual res_list (Prelude.filter (== 0) ls)
412 Right res_list -> checkListEqual res_list (Prelude.filter (== 0) ls)
@@ -492,7 +424,8 @@ some =
492 let
424 let
493 ls = 0 : genLs
425 ls = 0 : genLs
494 concatFold = FL.Fold (\concatList curr_list -> return $ FL.Partial $ concatList ++ curr_list) (return []) return
426 concatFold = FL.Fold (\concatList curr_list -> return $ FL.Partial $ concatList ++ curr_list) (return []) return
495− prsr = P.some concatFold $ P.sliceSepBy (== 1) FL.toList
427+ prsr = P.some concatFold
428+ $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList
496 in
429 in
497 case S.parse prsr (S.fromList ls) of
430 case S.parse prsr (S.fromList ls) of
498 Right res_list -> res_list == Prelude.filter (== 0) ls
431 Right res_list -> res_list == Prelude.filter (== 0) ls
@@ -515,9 +448,9 @@ applicative =
515 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
448 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
516 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
449 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
517 let parser =
450 let parser =
518− (,)
451+ (,)
519− <$> P.take (length list1) FL.toList
452+ <$> P.fromFold (FL.ltake (length list1) FL.toList)
520− <*> P.take (length list2) FL.toList
453+ <*> P.fromFold (FL.ltake (length list2) FL.toList)
521 in monadicIO $ do
454 in monadicIO $ do
522 (olist1, olist2) <-
455 (olist1, olist2) <-
523 run $ S.parse parser (S.fromList $ list1 ++ list2)
456 run $ S.parse parser (S.fromList $ list1 ++ list2)
@@ -529,11 +462,11 @@ applicative =
529sequence :: Property
462sequence :: Property
530sequence =
463sequence =
531 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0))) $ \ ins ->
464 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0))) $ \ ins ->
532− let parsers = fmap (\xs -> P.take (length xs) FL.toList) ins
465+ let p xs = P.fromFold (FL.ltake (length xs) FL.toList)
533 in monadicIO $ do
466 in monadicIO $ do
534 outs <- run $
467 outs <- run $
535 S.parse
468 S.parse
536− (Prelude.sequence parsers)
469+ (Prelude.sequence $ fmap p ins)
537 (S.fromList $ concat ins)
470 (S.fromList $ concat ins)
538 listEquals (==) outs ins
471 listEquals (==) outs ins
539
472
@@ -544,9 +477,9 @@ monad =
544 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
477 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
545 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
478 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
546 let parser = do
479 let parser = do
547− olist1 <- P.take (length list1) FL.toList
480+ olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)
548− olist2 <- P.take (length list2) FL.toList
481+ olist2 <- P.fromFold (FL.ltake (length list2) FL.toList)
549− return (olist1, olist2)
482+ return (olist1, olist2)
550 in monadicIO $ do
483 in monadicIO $ do
551 (olist1, olist2) <-
484 (olist1, olist2) <-
552 run $ S.parse parser (S.fromList $ list1 ++ list2)
485 run $ S.parse parser (S.fromList $ list1 ++ list2)
@@ -562,12 +495,11 @@ parseMany =
562 forAll (chooseInt (1,100)) $ \len ->
495 forAll (chooseInt (1,100)) $ \len ->
563 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
496 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
564 monadicIO $ do
497 monadicIO $ do
565− outs <-
498+ outs <- do
499+ let p = P.fromFold $ FL.ltake len FL.toList
566− ( run
500+ run
567− $ S.toList
501+ $ S.toList
568− $ S.parseMany
569− (P.take len FL.toList) (S.fromList $ concat ins)
502+ $ S.parseMany p (S.fromList $ concat ins)
570− )
571 listEquals (==) outs ins
503 listEquals (==) outs ins
572
504
573-------------------------------------------------------------------------------
505-------------------------------------------------------------------------------
@@ -653,8 +585,6 @@ main =
653
585
654 describe "test for accumulator" $ do
586 describe "test for accumulator" $ do
655 prop "P.fromFold FL.sum = FL.sum" fromFold
587 prop "P.fromFold FL.sum = FL.sum" fromFold
656− prop "P.any = Prelude.any" Main.any
657− prop "P.all = Prelude.all" Main.all
658 prop "yield value provided" yield
588 prop "yield value provided" yield
659 prop "yield monadic value provided" yieldM
589 prop "yield monadic value provided" yieldM
660 prop "fail err = Left (SomeException (ParseError err))" parserFail
590 prop "fail err = Left (SomeException (ParseError err))" parserFail
@@ -670,7 +600,6 @@ main =
670 prop "check first element exists and satisfies predicate" satisfy
600 prop "check first element exists and satisfies predicate" satisfy
671
601
672 describe "test for sequence parser" $ do
602 describe "test for sequence parser" $ do
673− prop "P.take = Prelude.take" Main.take
674 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
603 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
675 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ
604 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ
676 prop "P.takeGE n ls = ls when len >= n" takeGEPass
605 prop "P.takeGE n ls = ls when len >= n" takeGEPass
@@ -680,8 +609,6 @@ main =
680 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
609 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
681 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
610 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
682 prop "P.takeWhile = Prelude.takeWhile if taken something, else check why failed" takeWhile1
611 prop "P.takeWhile = Prelude.takeWhile if taken something, else check why failed" takeWhile1
683− prop "P.sliceSepBy = Prelude.takeWhile (not . predicate)" sliceSepBy
684− prop "P.sliceSepByMax n predicate = Prelude.take n (Prelude.takeWhile (not . predicate))" sliceSepByMax
685 -- prop "" splitWithPass
612 -- prop "" splitWithPass
686 -- prop "" splitWithFailLeft
613 -- prop "" splitWithFailLeft
687 -- prop "" splitWithFailRight
614 -- prop "" splitWithFailRight
test/Streamly/Test/Data/Parser/ParserD.hs+18−63
@@ -1,17 +1,14 @@
1module Main (main) where
1module Main (main) where
2
2
3import Control.Exception (SomeException(..))
3import Control.Exception (SomeException(..))
4−import Control.Monad (when)
5−import Control.Monad.IO.Class (MonadIO(..))
6−import Data.List ((\\))
7import Data.Word (Word8, Word32, Word64)
4import Data.Word (Word8, Word32, Word64)
5+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
8import Test.Hspec (Spec, hspec, describe)
6import Test.Hspec (Spec, hspec, describe)
9import Test.Hspec.QuickCheck
7import Test.Hspec.QuickCheck
10import Test.QuickCheck
8import Test.QuickCheck
11− (arbitrary, forAll, choose, elements, Property,
9+ (arbitrary, forAll, elements, Property,
12− property, listOf, vectorOf, counterexample, (.&&.), Gen, suchThat)
10+ property, listOf, vectorOf, (.&&.), Gen, suchThat)
13−import Test.QuickCheck.Monadic
11+import Test.QuickCheck.Monadic (monadicIO, assert, run)
14− (monadicIO, PropertyM, assert, monitor, run)
15
12
16import qualified Streamly.Internal.Data.Parser.ParserD as P
13import qualified Streamly.Internal.Data.Parser.ParserD as P
17import qualified Streamly.Internal.Data.Stream.IsStream as S
14import qualified Streamly.Internal.Data.Stream.IsStream as S
@@ -52,30 +49,6 @@ max_value = 10000
52max_length :: Int
49max_length :: Int
53max_length = 1000
50max_length = 1000
54
51
55−listEquals :: (Show a, Eq a, MonadIO m)
56− => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
57−listEquals eq parsed_list list = do
58− when (not $ parsed_list `eq` list) $ liftIO $ putStrLn $
59− "parsed list " ++ show parsed_list
60− ++ "\nlist " ++ show list
61− ++ "\nparsed list \\\\ list " ++ show (parsed_list \\ list)
62− ++ "\nlist \\\\ parsed list " ++ show (list \\ parsed_list)
63− when (not $ parsed_list `eq` list) $
64− monitor
65− (counterexample $
66− "parsed list " ++ show parsed_list
67− ++ "\nlist " ++ show list
68− ++ "\nparsed list \\\\ list " ++ show (parsed_list \\ list)
69− ++ "\nlist \\\\ parsed list " ++ show (list \\ parsed_list)
70− )
71− assert (parsed_list `eq` list)
72−
73−checkListEqual :: (Show a, Eq a) => [a] -> [a] -> Property
74−checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)
75−
76−chooseInt :: (Int, Int) -> Gen Int
77−chooseInt = choose
78−
79-- Accumulator Tests
52-- Accumulator Tests
80
53
81fromFold :: Property
54fromFold :: Property
@@ -87,20 +60,6 @@ fromFold =
87 Right is_equal -> is_equal
60 Right is_equal -> is_equal
88 Left _ -> False
61 Left _ -> False
89
62
90−any :: Property
91−any =
92− forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
93− case S.parseD (P.any (> mid_value)) (S.fromList ls) of
94− Right r -> r == (Prelude.any (> mid_value) ls)
95− Left _ -> False
96−
97−all :: Property
98−all =
99− forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
100− case S.parseD (P.all (> mid_value)) (S.fromList ls) of
101− Right r -> r == (Prelude.all (> mid_value) ls)
102− Left _ -> False
103−
104yield :: Property
63yield :: Property
105yield =
64yield =
106 forAll (chooseInt (min_value, max_value)) $ \x ->
65 forAll (chooseInt (min_value, max_value)) $ \x ->
@@ -192,7 +151,7 @@ take :: Property
192take =
151take =
193 forAll (chooseInt (min_value, max_value)) $ \n ->
152 forAll (chooseInt (min_value, max_value)) $ \n ->
194 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
153 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
195− case S.parseD (P.take n FL.toList) (S.fromList ls) of
154+ case S.parseD (P.fromFold $ FL.ltake n FL.toList) (S.fromList ls) of
196 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
155 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
197 Left _ -> property False
156 Left _ -> property False
198
157
@@ -261,8 +220,6 @@ nLessThanEqual0 tk ltk =
261takeProperties :: Spec
220takeProperties :: Spec
262takeProperties =
221takeProperties =
263 describe "take combinators when n <= 0/" $ do
222 describe "take combinators when n <= 0/" $ do
264− prop "take n FL.toList = []" $
265− nLessThanEqual0 P.take (\_ -> const [])
266 prop "takeEQ n FL.toList = []" $
223 prop "takeEQ n FL.toList = []" $
267 nLessThanEqual0 P.takeEQ (\_ -> const [])
224 nLessThanEqual0 P.takeEQ (\_ -> const [])
268 prop "takeGE n FL.toList xs = xs" $
225 prop "takeGE n FL.toList xs = xs" $
@@ -275,7 +232,7 @@ lookAheadPass :: Property
275lookAheadPass =
232lookAheadPass =
276 forAll (chooseInt (min_value, max_value)) $ \n ->
233 forAll (chooseInt (min_value, max_value)) $ \n ->
277 let
234 let
278− takeWithoutConsume = P.lookAhead $ P.take n FL.toList
235+ takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.ltake n FL.toList
279 parseTwice = do
236 parseTwice = do
280 parsed_list_1 <- takeWithoutConsume
237 parsed_list_1 <- takeWithoutConsume
281 parsed_list_2 <- takeWithoutConsume
238 parsed_list_2 <- takeWithoutConsume
@@ -291,7 +248,7 @@ lookAhead :: Property
291lookAhead =
248lookAhead =
292 forAll (chooseInt (min_value, max_value)) $ \n ->
249 forAll (chooseInt (min_value, max_value)) $ \n ->
293 let
250 let
294− takeWithoutConsume = P.lookAhead $ P.take n FL.toList
251+ takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.ltake n FL.toList
295 parseTwice = do
252 parseTwice = do
296 parsed_list_1 <- takeWithoutConsume
253 parsed_list_1 <- takeWithoutConsume
297 parsed_list_2 <- takeWithoutConsume
254 parsed_list_2 <- takeWithoutConsume
@@ -333,7 +290,7 @@ takeWhile1 =
333sliceSepBy :: Property
290sliceSepBy :: Property
334sliceSepBy =
291sliceSepBy =
335 forAll (listOf (chooseInt (0, 1))) $ \ls ->
292 forAll (listOf (chooseInt (0, 1))) $ \ls ->
336− case S.parseD (P.sliceSepBy predicate FL.toList) (S.fromList ls) of
293+ case S.parseD (P.fromFold $ FL.sliceSepBy predicate FL.toList) (S.fromList ls) of
337 Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile (not . predicate) ls)
294 Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile (not . predicate) ls)
338 Left _ -> property False
295 Left _ -> property False
339 where
296 where
@@ -343,7 +300,7 @@ sliceSepByMax :: Property
343sliceSepByMax =
300sliceSepByMax =
344 forAll (chooseInt (min_value, max_value)) $ \n ->
301 forAll (chooseInt (min_value, max_value)) $ \n ->
345 forAll (listOf (chooseInt (0, 1))) $ \ls ->
302 forAll (listOf (chooseInt (0, 1))) $ \ls ->
346− case S.parseD (P.sliceSepByMax predicate n FL.toList) (S.fromList ls) of
303+ case S.parseD (P.fromFold $ FL.sliceSepByMax predicate n FL.toList) (S.fromList ls) of
347 Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
304 Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
348 Left _ -> property False
305 Left _ -> property False
349 where
306 where
@@ -383,7 +340,7 @@ teeWithPass =
383 forAll (chooseInt (min_value, max_value)) $ \n ->
340 forAll (chooseInt (min_value, max_value)) $ \n ->
384 forAll (listOf (chooseInt (0, 1))) $ \ls ->
341 forAll (listOf (chooseInt (0, 1))) $ \ls ->
385 let
342 let
386− prsr = P.take n FL.toList
343+ prsr = P.fromFold $ FL.ltake n FL.toList
387 in
344 in
388 case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of
345 case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of
389 Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
346 Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
@@ -480,7 +437,7 @@ many =
480 let fldstp conL currL = return $ FL.Partial (conL ++ currL)
437 let fldstp conL currL = return $ FL.Partial (conL ++ currL)
481 concatFold =
438 concatFold =
482 FL.Fold fldstp (return []) return
439 FL.Fold fldstp (return []) return
483− prsr = P.many concatFold $ P.sliceSepBy (== 1) FL.toList
440+ prsr = P.many concatFold $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList
484 in case S.parseD prsr (S.fromList ls) of
441 in case S.parseD prsr (S.fromList ls) of
485 Right res_list ->
442 Right res_list ->
486 checkListEqual res_list (Prelude.filter (== 0) ls)
443 checkListEqual res_list (Prelude.filter (== 0) ls)
@@ -498,7 +455,7 @@ some =
498 $ \ls ->
455 $ \ls ->
499 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
456 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
500 concatFold = FL.Fold fldstp (return []) return
457 concatFold = FL.Fold fldstp (return []) return
501− prsr = P.some concatFold $ P.sliceSepBy (== 1) FL.toList
458+ prsr = P.some concatFold $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList
502 in case S.parseD prsr (S.fromList ls) of
459 in case S.parseD prsr (S.fromList ls) of
503 Right res_list -> res_list == Prelude.filter (== 0) ls
460 Right res_list -> res_list == Prelude.filter (== 0) ls
504 Left _ -> False
461 Left _ -> False
@@ -521,8 +478,8 @@ applicative =
521 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
478 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
522 let parser =
479 let parser =
523 (,)
480 (,)
524− <$> P.take (length list1) FL.toList
481+ <$> P.fromFold (FL.ltake (length list1) FL.toList)
525− <*> P.take (length list2) FL.toList
482+ <*> P.fromFold (FL.ltake (length list2) FL.toList)
526 in monadicIO $ do
483 in monadicIO $ do
527 (olist1, olist2) <-
484 (olist1, olist2) <-
528 run $ S.parseD parser (S.fromList $ list1 ++ list2)
485 run $ S.parseD parser (S.fromList $ list1 ++ list2)
@@ -534,7 +491,7 @@ applicative =
534sequence :: Property
491sequence :: Property
535sequence =
492sequence =
536 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0))) $ \ ins ->
493 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0))) $ \ ins ->
537− let parsers = fmap (\xs -> P.take (length xs) FL.toList) ins
494+ let parsers = fmap (\xs -> P.fromFold $ FL.ltake (length xs) FL.toList) ins
538 in monadicIO $ do
495 in monadicIO $ do
539 outs <- run $
496 outs <- run $
540 S.parseD
497 S.parseD
@@ -549,8 +506,8 @@ monad =
549 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
506 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
550 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
507 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
551 let parser = do
508 let parser = do
552− olist1 <- P.take (length list1) FL.toList
509+ olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)
553− olist2 <- P.take (length list2) FL.toList
510+ olist2 <- P.fromFold (FL.ltake (length list2) FL.toList)
554 return (olist1, olist2)
511 return (olist1, olist2)
555 in monadicIO $ do
512 in monadicIO $ do
556 (olist1, olist2) <-
513 (olist1, olist2) <-
@@ -571,7 +528,7 @@ parseMany =
571 ( run
528 ( run
572 $ S.toList
529 $ S.toList
573 $ S.parseManyD
530 $ S.parseManyD
574− (P.take len FL.toList) (S.fromList $ concat ins)
531+ (P.fromFold $ FL.ltake len FL.toList) (S.fromList $ concat ins)
575 )
532 )
576 listEquals (==) outs ins
533 listEquals (==) outs ins
577
534
@@ -657,8 +614,6 @@ main =
657
614
658 describe "test for accumulator" $ do
615 describe "test for accumulator" $ do
659 prop "P.fromFold FL.sum = FL.sum" fromFold
616 prop "P.fromFold FL.sum = FL.sum" fromFold
660− prop "P.any = Prelude.any" Main.any
661− prop "P.all = Prelude.all" Main.all
662 prop "yield value provided" yield
617 prop "yield value provided" yield
663 prop "yield monadic value provided" yieldM
618 prop "yield monadic value provided" yieldM
664 prop "always fail" die
619 prop "always fail" die