git.iko.soy/streamly
on master help sign in
Remove redundant parsers, update docs

Remove the parsers that are covered by terminating folds.

commitd5af0bfb5dd20725150536dc1a8541b0274ee8c4 authorHarendra Kumar <harendra@composewell.com> dateThu 10 Dec 2020, 20:18 (6 years ago) parent82efd3a
10 files changed+227−538
compare with master
unifiedsplit
benchmark/Streamly/Benchmark/Data/Parser.hs+68−49 benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+44−43 benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+5−36 src/Streamly/Internal/Data/Parser.hs+45−178 src/Streamly/Internal/Data/Parser/ParserD.hs+14−63 src/Streamly/Internal/Data/Parser/ParserD/Types.hs+7−11 src/Streamly/Internal/FileSystem/Event/Linux.hs+3−1 streamly.cabal+2 test/Streamly/Test/Data/Parser.hs+21−94 test/Streamly/Test/Data/Parser/ParserD.hs+18−63
benchmark/Streamly/Benchmark/Data/Parser.hs+68−49
@@ -15,6 +15,7 @@ module Main
1515import Control.DeepSeq (NFData(..))
1616import Control.Monad.Catch (MonadCatch)
1717import Data.Foldable (asum)
18+import Data.Functor (($>))
1819import Data.Monoid (Sum(..))
1920import System.Random (randomRIO)
2021import Prelude
@@ -59,22 +60,14 @@ benchIOSink value name f =
5960-- Parsers
6061-------------------------------------------------------------------------------
6162
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−
7463{-# INLINE takeEQ #-}
7564takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()
7665takeEQ value = IP.parse (PR.takeEQ value FL.drain)
7766
67+{-# INLINE drainWhile #-}
68+drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
69+drainWhile value = IP.parse (PR.drainWhile (<= value))
70+
7871{-# INLINE takeWhile #-}
7972takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
8073takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
@@ -106,57 +99,91 @@ manyTill value =
10699
107100{-# INLINE splitAp #-}
108101splitAp :: MonadCatch m
109− => Int -> SerialT m Int -> m (Bool, Bool)
102+ => Int -> SerialT m Int -> m ((), ())
110103splitAp value =
111− IP.parse ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
104+ IP.parse
105+ ((,)
106+ <$> PR.drainWhile (<= (value `div` 2))
107+ <*> PR.drainWhile (<= value)
108+ )
112109
113110{-# INLINE splitApBefore #-}
114111splitApBefore :: MonadCatch m
115− => Int -> SerialT m Int -> m Bool
112+ => Int -> SerialT m Int -> m ()
116113splitApBefore value =
117− IP.parse (PR.all (<= (value `div` 2)) *> PR.any (> value))
114+ IP.parse
115+ ( PR.drainWhile (<= (value `div` 2))
116+ *> PR.drainWhile (<= value)
117+ )
118118
119119{-# INLINE splitApAfter #-}
120120splitApAfter :: MonadCatch m
121− => Int -> SerialT m Int -> m Bool
121+ => Int -> SerialT m Int -> m ()
122122splitApAfter value =
123− IP.parse (PR.all (<= (value `div` 2)) <* PR.any (> value))
123+ IP.parse
124+ ( PR.drainWhile (<= (value `div` 2))
125+ <* PR.drainWhile (<= value)
126+ )
124127
125128{-# INLINE splitWith #-}
126129splitWith :: MonadCatch m
127− => Int -> SerialT m Int -> m (Bool, Bool)
130+ => Int -> SerialT m Int -> m ((), ())
128131splitWith value =
129− IP.parse (PR.splitWith (,) (PR.all (<= (value `div` 2))) (PR.any (> value)))
132+ IP.parse
133+ (PR.splitWith (,)
134+ (PR.drainWhile (<= (value `div` 2)))
135+ (PR.drainWhile (<= value))
136+ )
130137
131138{-# INLINE split_ #-}
132139split_ :: MonadCatch m
133− => Int -> SerialT m Int -> m Bool
140+ => Int -> SerialT m Int -> m ()
134141split_ 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+ )
136147
137148{-# INLINE teeAllAny #-}
138−teeAllAny :: (MonadCatch m, Ord a)
139− => a -> SerialT m a -> m (Bool, Bool)
149+teeAllAny :: MonadCatch m
150+ => Int -> SerialT m Int -> m ((), ())
140151teeAllAny value =
141− IP.parse (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
152+ IP.parse
153+ (PR.teeWith (,)
154+ (PR.drainWhile (<= value))
155+ (PR.drainWhile (<= value))
156+ )
142157
143158{-# INLINE teeFstAllAny #-}
144−teeFstAllAny :: (MonadCatch m, Ord a)
145− => a -> SerialT m a -> m (Bool, Bool)
159+teeFstAllAny :: MonadCatch m
160+ => Int -> SerialT m Int -> m ((), ())
146161teeFstAllAny value =
147− IP.parse (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
162+ IP.parse
163+ (PR.teeWithFst (,)
164+ (PR.drainWhile (<= value))
165+ (PR.drainWhile (<= value))
166+ )
148167
149168{-# INLINE shortestAllAny #-}
150−shortestAllAny :: (MonadCatch m, Ord a)
151− => a -> SerialT m a -> m Bool
169+shortestAllAny :: MonadCatch m
170+ => Int -> SerialT m Int -> m ()
152171shortestAllAny value =
153− IP.parse (PR.shortest (PR.all (<= value)) (PR.any (> value)))
172+ IP.parse
173+ (PR.shortest
174+ (PR.drainWhile (<= value))
175+ (PR.drainWhile (<= value))
176+ )
154177
155178{-# INLINE longestAllAny #-}
156−longestAllAny :: (MonadCatch m, Ord a)
157− => a -> SerialT m a -> m Bool
179+longestAllAny :: MonadCatch m
180+ => Int -> SerialT m Int -> m ()
158181longestAllAny value =
159− IP.parse (PR.longest (PR.all (<= value)) (PR.any (> value)))
182+ IP.parse
183+ (PR.longest
184+ (PR.drainWhile (<= value))
185+ (PR.drainWhile (<= value))
186+ )
160187
161188-------------------------------------------------------------------------------
162189-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -169,7 +196,7 @@ longestAllAny value =
169196{-# INLINE lookAhead #-}
170197lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
171198lookAhead value =
172− IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
199+ IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
173200
174201{-# INLINE sequenceA #-}
175202sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
@@ -208,7 +235,7 @@ parseMany :: MonadCatch m => SerialT m Int -> m ()
208235parseMany =
209236 S.drain
210237 . S.map getSum
211− . IP.parseMany (PR.take 2 FL.mconcat)
238+ . IP.parseMany (PR.fromFold $ FL.ltake 2 FL.mconcat)
212239 . S.map Sum
213240
214241{-# INLINE parseIterate #-}
@@ -216,7 +243,7 @@ parseIterate :: MonadCatch m => SerialT m Int -> m ()
216243parseIterate =
217244 S.drain
218245 . 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)
220247 . S.map Sum
221248
222249-------------------------------------------------------------------------------
@@ -228,11 +255,9 @@ moduleName = "Data.Parser"
228255
229256o_1_space_serial :: Int -> [Benchmark]
230257o_1_space_serial value =
231− [ benchIOSink value "any" $ any value
232− , benchIOSink value "all" $ all value
233− , benchIOSink value "take" $ take value
234− , benchIOSink value "takeEQ" $ takeEQ value
258+ [ benchIOSink value "takeEQ" $ takeEQ value
235259 , benchIOSink value "takeWhile" $ takeWhile value
260+ , benchIOSink value "drainWhile" $ drainWhile value
236261 , benchIOSink value "splitAp" $ splitAp value
237262 , benchIOSink value "splitApBefore" $ splitApBefore value
238263 , benchIOSink value "splitApAfter" $ splitApAfter value
@@ -284,12 +309,6 @@ main = do
284309 where
285310
286311 allBenchmarks value =
287− [ bgroup (o_1_space_prefix moduleName) $ concat
288− [
289− o_1_space_serial value
290− ]
291− , bgroup (o_n_heap_prefix moduleName) $ concat
292− [
293− o_n_heap_serial value
294− ]
312+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
313+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
295314 ]
benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+44−43
@@ -16,6 +16,7 @@ module Main
1616import Control.DeepSeq (NFData(..))
1717import Control.Monad.Catch (MonadCatch, MonadThrow)
1818import Data.Foldable (asum)
19+import Data.Functor (($>))
1920import System.Random (randomRIO)
2021import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
2122
@@ -58,21 +59,13 @@ benchIOSink value name f =
5859-- Parsers
5960-------------------------------------------------------------------------------
6061
61−{-# INLINE any #-}
62−any :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
63−any value = IP.parseD (PR.any (> value))
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)
62+{-# INLINE drainWhile #-}
63+drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()
64+drainWhile p = PR.takeWhile p FL.drain
7265
7366{-# INLINE takeWhile #-}
7467takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
75−takeWhile value = IP.parseD (PR.takeWhile (<= value) FL.drain)
68+takeWhile value = IP.parseD (drainWhile (<= value))
7669
7770{-# INLINE many #-}
7871many :: MonadCatch m => SerialT m Int -> m Int
@@ -103,33 +96,53 @@ manyTill value =
10396
10497{-# INLINE splitAllAny #-}
10598splitAllAny :: MonadThrow m
106− => Int -> SerialT m Int -> m (Bool, Bool)
99+ => Int -> SerialT m Int -> m ((), ())
107100splitAllAny 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+ )
109106
110107{-# INLINE teeAllAny #-}
111−teeAllAny :: (MonadThrow m, Ord a)
112− => a -> SerialT m a -> m (Bool, Bool)
108+teeAllAny :: MonadThrow m
109+ => Int -> SerialT m Int -> m ((), ())
113110teeAllAny 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+ )
115116
116117{-# INLINE teeFstAllAny #-}
117−teeFstAllAny :: (MonadThrow m, Ord a)
118− => a -> SerialT m a -> m (Bool, Bool)
118+teeFstAllAny :: MonadThrow m
119+ => Int -> SerialT m Int -> m ((), ())
119120teeFstAllAny value =
120− IP.parseD (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
121+ IP.parseD
122+ (PR.teeWithFst (,)
123+ (drainWhile (<= value))
124+ (drainWhile (<= value))
125+ )
121126
122127{-# INLINE shortestAllAny #-}
123−shortestAllAny :: (MonadThrow m, Ord a)
124− => a -> SerialT m a -> m Bool
128+shortestAllAny :: MonadThrow m
129+ => Int -> SerialT m Int -> m ()
125130shortestAllAny value =
126− IP.parseD (PR.shortest (PR.all (<= value)) (PR.any (> value)))
131+ IP.parseD
132+ (PR.shortest
133+ (drainWhile (<= value))
134+ (drainWhile (<= value))
135+ )
127136
128137{-# INLINE longestAllAny #-}
129−longestAllAny :: (MonadCatch m, Ord a)
130− => a -> SerialT m a -> m Bool
138+longestAllAny :: MonadCatch m
139+ => Int -> SerialT m Int -> m ()
131140longestAllAny 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+ )
133146
134147-------------------------------------------------------------------------------
135148-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -142,7 +155,7 @@ longestAllAny value =
142155{-# INLINE lookAhead #-}
143156lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
144157lookAhead value =
145− IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
158+ IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
146159
147160{-# INLINE sequenceA_ #-}
148161sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
@@ -181,10 +194,7 @@ moduleName = "Data.Parser.ParserD"
181194
182195o_1_space_serial :: Int -> [Benchmark]
183196o_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
188198 , benchIOSink value "split (all,any)" $ splitAllAny value
189199 , benchIOSink value "many" many
190200 , benchIOSink value "some" some
@@ -228,16 +238,7 @@ main = do
228238 where
229239
230240 allBenchmarks value =
231− [ bgroup (o_1_space_prefix moduleName) $ concat
232− [
233− o_1_space_serial value
234− ]
235− , bgroup (o_n_heap_prefix moduleName) $ concat
236− [
237− o_n_heap_serial value
238− ]
239− , bgroup (o_n_space_prefix moduleName) $ concat
240− [
241− o_n_space_serial value
242− ]
241+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
242+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
243+ , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
243244 ]
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+5−36
@@ -69,30 +69,6 @@ benchIOSink value name f =
6969satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
7070satisfy = PR.toParserK . PRD.satisfy
7171
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−
9672{-# INLINE takeWhile #-}
9773takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
9874takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
@@ -103,9 +79,9 @@ takeWhileK value = PARSE_OP (takeWhile (<= value))
10379
10480{-# INLINE splitApp #-}
10581splitApp :: MonadCatch m
106− => Int -> SerialT m Int -> m (Bool, Bool)
82+ => Int -> SerialT m Int -> m ((), ())
10783splitApp value =
108− PARSE_OP ((,) <$> any (>= (value `div` 2)) <*> any (> value))
84+ PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))
10985
11086{-# INLINE sequenceA #-}
11187sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
@@ -157,10 +133,7 @@ moduleName = "Data.Parser.ParserK"
157133
158134o_1_space_serial :: Int -> [Benchmark]
159135o_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
164137 , benchIOSink value "splitApp" $ splitApp value
165138 ]
166139
@@ -187,10 +160,6 @@ main = do
187160 where
188161
189162 allBenchmarks value =
190− [ bgroup (o_1_space_prefix moduleName) $ concat
191− [ o_1_space_serial value
192− ]
193− , bgroup (o_n_heap_prefix moduleName) $ concat
194− [ o_n_heap_serial value
195− ]
163+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
164+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
196165 ]
src/Streamly/Internal/Data/Parser.hs+45−178
@@ -54,8 +54,6 @@ module Streamly.Internal.Data.Parser
5454 -- First order parsers
5555 -- * Accumulators
5656 , fromFold
57− , any
58− , all
5957 , yield
6058 , yieldM
6159 , die
@@ -75,8 +73,7 @@ module Streamly.Internal.Data.Parser
7573
7674 -- | Grab a sequence of input elements without inspecting them
7775 , takeBetween
78− , take -- takeBetween 0 n
79− -- $take
76+ -- , take -- takeBetween 0 n
8077 , takeEQ -- takeBetween n n
8178 , takeGE -- takeBetween n maxBound
8279
@@ -86,11 +83,9 @@ module Streamly.Internal.Data.Parser
8683 , takeWhile
8784 -- $takeWhile
8885 , takeWhile1
86+ , drainWhile
8987
90− , sliceSepByP
9188 , sliceSepBy
92− , sliceSepByMax
93− , sliceEndWith
9489 , sliceBeginWith
9590 , sliceSepWith
9691 , escapedSliceSepBy
@@ -134,7 +129,7 @@ module Streamly.Internal.Data.Parser
134129
135130 -- * N-ary Combinators
136131 -- ** Sequential Collection
137− , sequence
132+ , concatSequence
138133 , concatMap
139134
140135 -- ** Sequential Repetition
@@ -206,6 +201,7 @@ import Prelude
206201import Streamly.Internal.Data.Fold.Types (Fold(..))
207202import Streamly.Internal.Data.Parser.ParserK.Types (Parser)
208203
204+import qualified Streamly.Internal.Data.Fold as FL
209205import qualified Streamly.Internal.Data.Parser.ParserD as D
210206import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
211207
@@ -225,22 +221,6 @@ fromFold = K.toParserK . D.fromFold
225221-- Terminating but not failing folds
226222-------------------------------------------------------------------------------
227223--
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−
244224-- This is the dual of stream "yield".
245225--
246226-- | A parser that always yields a pure value without consuming any input.
@@ -377,35 +357,6 @@ takeBetween :: -- MonadCatch m =>
377357 Int -> Int -> Fold m a b -> Parser m a b
378358takeBetween _m _n = undefined -- K.toParserK . D.takeBetween m n
379359
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−
409360-- | Stops after taking exactly @n@ input elements.
410361--
411362-- * Stops - after consuming @n@ elements.
@@ -423,8 +374,9 @@ takeEQ n = K.toParserK . D.takeEQ n
423374
424375-- | Take at least @n@ input elements, but can collect more.
425376--
426−-- * Stops - never.
427−-- * Fails - if the stream end before producing @n@ elements.
377+-- * Stops - when the collecting fold stops.
378+-- * Fails - if the stream or the collecting fold ends before producing @n@
379+-- elements.
428380--
429381-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1]
430382-- > "takeGE: Expecting at least 4 elements, got only 3"
@@ -465,7 +417,7 @@ takeWhileP _cond = undefined -- K.toParserK . D.takeWhileP cond
465417-- | Collect stream elements until an element fails the predicate. The element
466418-- on which the predicate fails is returned back to the input stream.
467419--
468−-- * Stops - when the predicate fails.
420+-- * Stops - when the predicate fails or the collecting fold stops.
469421-- * Fails - never.
470422--
471423-- >>> 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
491443takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
492444takeWhile1 cond = K.toParserK . D.takeWhile1 cond
493445
494−-- | Like 'sliceSepBy' but uses a 'Parser' instead of a 'Fold' to collect the
495−-- input. @sliceSepByP cond parser@ parses a slice of the input using @parser@
496−-- until @cond@ succeeds or the parser stops.
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+
457+-- | @sliceSepBy cond parser@ parses a slice of the input using @parser@ until
458+-- @cond@ succeeds or the parser stops.
497459--
498460-- This is a generalized slicing parser which can be used to implement other
499461-- parsers e.g.:
@@ -505,59 +467,10 @@ takeWhile1 cond = K.toParserK . D.takeWhile1 cond
505467--
506468-- /Unimplemented/
507469--
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/
558470{-# INLINABLE sliceSepBy #-}
559−sliceSepBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
560−sliceSepBy cond = K.toParserK . D.sliceSepBy cond
471+sliceSepBy :: -- MonadCatch m =>
472+ (a -> Bool) -> Parser m a b -> Parser m a b
473+sliceSepBy _cond = undefined -- K.toParserK . D.sliceSepBy cond
561474
562475-- | Like 'sliceSepBy' but does not drop the separator element, instead
563476-- separator is emitted as a separate element in the output.
@@ -568,23 +481,6 @@ sliceSepWith :: -- MonadCatch m =>
568481 (a -> Bool) -> Fold m a b -> Parser m a b
569482sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond
570483
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−
588484-- | Collect stream elements until an elements passes the predicate, return the
589485-- last element on which the predicate succeeded back to the input stream. If
590486-- the predicate succeeds on the first element itself then it is kept in the
@@ -604,44 +500,6 @@ sliceBeginWith ::
604500 (a -> Bool) -> Fold m a b -> Parser m a b
605501sliceBeginWith = undefined
606502
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−
645503-- | Like 'sliceSepBy' but the separator elements can be escaped using an
646504-- escape char determined by the second predicate.
647505--
@@ -911,18 +769,19 @@ deintercalate = undefined
911769-- Sequential Collection
912770-------------------------------------------------------------------------------
913771--
914−-- | @sequence f t@ collects sequential parses of parsers in the container @t@
915−-- using the fold @f@. Fails if the input ends or any of the parsers fail.
772+-- | @concatSequence f t@ collects sequential parses of parsers in the
773+-- container @t@ using the fold @f@. Fails if the input ends or any of the
774+-- parsers fail.
916775--
917776-- This is same as 'Data.Traversable.sequence' but more efficient.
918777--
919778-- /Unimplemented/
920779--
921−{-# INLINE sequence #-}
922−sequence ::
780+{-# INLINE concatSequence #-}
781+concatSequence ::
923782 -- Foldable t =>
924783 Fold m b c -> t (Parser m a b) -> Parser m a c
925−sequence _f _p = undefined
784+concatSequence _f _p = undefined
926785
927786-- | Map a 'Parser' returning function on the result of a 'Parser'.
928787--
@@ -974,10 +833,11 @@ manyP :: -- MonadCatch m =>
974833 Parser m b c -> Parser m a b -> Parser m a c
975834manyP _f _p = undefined -- K.toParserK $ D.manyP f (K.fromParserK p)
976835
977−-- | Collect zero or more parses. Apply the parser repeatedly on the input
978−-- stream, stop when the parser fails, accumulate zero or more parse results
979−-- using the supplied 'Fold'. This parser never fails, in case the first
980−-- application of parser fails it returns an empty result.
836+-- | Collect zero or more parses. Apply the supplied parser repeatedly on the
837+-- input stream and push the parse results to a downstream fold.
838+--
839+-- Stops: when the downstream fold stops or the parser fails.
840+-- Fails: never, produces zero or more results.
981841--
982842-- Compare with 'Control.Applicative.many'.
983843--
@@ -988,10 +848,15 @@ many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
988848many f p = K.toParserK $ D.many f (K.fromParserK p)
989849-- many = countBetween 0 maxBound
990850
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+--
991855-- | 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
993−-- succeeds, stop when it fails. This parser fails if not even one result is
994−-- collected.
856+-- input stream and push the parse results to a downstream fold.
857+--
858+-- Stops: when the downstream fold stops or the parser fails.
859+-- Fails: if it stops without producing a single result.
995860--
996861-- @some fld parser = many (takeGE 1 fld) parser@
997862--
@@ -1054,6 +919,8 @@ manyTillP _f _p1 _p2 = undefined
1054919-- @test@ is discarded and the output of @collect@ is accumulated by the
1055920-- supplied fold. The parser fails if @collect@ fails.
1056921--
922+-- Stops when the fold @f@ stops.
923+--
1057924-- /Internal/
1058925--
1059926{-# INLINE manyTill #-}
src/Streamly/Internal/Data/Parser/ParserD.hs+14−63
@@ -19,8 +19,6 @@ module Streamly.Internal.Data.Parser.ParserD
1919 -- First order parsers
2020 -- * Accumulators
2121 , fromFold
22− , any
23− , all
2422 , yield
2523 , yieldM
2624 , die
@@ -45,7 +43,6 @@ module Streamly.Internal.Data.Parser.ParserD
4543 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
4644 --
4745 -- Grab a sequence of input elements without inspecting them
48− , take
4946 -- , takeBetween
5047 -- , takeLE -- take -- takeBetween 0 n
5148 -- , takeLE1 -- take1 -- takeBetween 1 n
@@ -57,9 +54,7 @@ module Streamly.Internal.Data.Parser.ParserD
5754 , takeWhile
5855 , takeWhile1
5956 , sliceSepBy
60− , sliceSepByMax
6157 -- , sliceSepByBetween
62− , sliceEndWith
6358 , sliceBeginWith
6459 -- , sliceSepWith
6560 --
@@ -164,7 +159,6 @@ import Streamly.Internal.Data.Fold.Types (Fold(..))
164159import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
165160
166161import qualified Streamly.Internal.Data.Fold.Types as FL
167−import qualified Streamly.Internal.Data.Fold as FL
168162
169163import Prelude hiding
170164 (any, all, take, takeWhile, sequence, concatMap, maybe, either)
@@ -192,19 +186,6 @@ fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
192186 FL.Partial s1 -> Partial 0 s1
193187 FL.Done b -> Done 0 b
194188
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−
208189-------------------------------------------------------------------------------
209190-- Failing Parsers
210191-------------------------------------------------------------------------------
@@ -300,16 +281,6 @@ either parser = Parser step initial extract
300281-- Taking elements
301282-------------------------------------------------------------------------------
302283
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−
313284-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
314285--
315286-- /Internal/
@@ -340,6 +311,7 @@ takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract
340311 <$> case res of
341312 FL.Partial s -> fextract s
342313 FL.Done b -> return b
314+ -- XXX we should not reach here when initial returns Step type
343315 -- reachable only when n == 0
344316 | otherwise = Done 1 <$> fextract r
345317
@@ -420,7 +392,6 @@ takeWhile predicate (Fold fstep finitial fextract) =
420392 FL.Done b -> Done 0 b
421393 else Done 1 <$> fextract s
422394
423−
424395-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
425396--
426397-- /Internal/
@@ -443,7 +414,7 @@ takeWhile1 predicate (Fold fstep finitial fextract) =
443414 $ case sr of
444415 FL.Partial r -> Partial 0 (Just r)
445416 FL.Done b -> Done 0 b
446− else return $ Error err
417+ else return $ Error "takeWhile1: predicate failed on first element"
447418 step (Just s) a =
448419 if predicate a
449420 then do
@@ -455,28 +426,16 @@ takeWhile1 predicate (Fold fstep finitial fextract) =
455426 b <- fextract s
456427 return $ Done 1 b
457428
458− extract Nothing = throwM $ ParseError err
429+ extract Nothing = throwM $ ParseError "takeWhile1: end of input"
459430 extract (Just s) = fextract s
460431
461− err = "takeWhile1: end of input"
462−
463432-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
464433--
465434-- /Internal/
466435--
467−{-# INLINABLE sliceSepBy #-}
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
479−sliceEndWith = undefined
436+sliceSepBy :: -- MonadCatch m =>
437+ (a -> Bool) -> Parser m a b -> Parser m a b
438+sliceSepBy _cond = undefined
480439
481440-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
482441--
@@ -488,15 +447,6 @@ sliceBeginWith ::
488447 (a -> Bool) -> Fold m a b -> Parser m a b
489448sliceBeginWith = undefined
490449
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−
500450-- | See 'Streamly.Internal.Data.Parser.wordBy'.
501451--
502452-- /Unimplemented/
@@ -709,6 +659,7 @@ manyTill (Fold fstep finitial fextract)
709659 Error _ -> do
710660 rR <- initialL
711661 return $ Continue (cnt + 1) (ManyTillL 0 fs rR)
662+ -- XXX the cnt is being used only by the assert
712663 step (ManyTillL cnt fs st) a = do
713664 r <- stepL st a
714665 case r of
@@ -717,17 +668,17 @@ manyTill (Fold fstep finitial fextract)
717668 assert (cnt + 1 - n >= 0) (return ())
718669 return $ Continue n (ManyTillL (cnt + 1 - n) fs s)
719670 Done n b -> do
720− sfs1 <- fstep fs b
721− case sfs1 of
722− FL.Partial fs1 -> do
671+ fs1 <- fstep fs b
672+ case fs1 of
673+ FL.Partial s -> do
723674 l <- initialR
724− return $ Partial n (ManyTillR 0 fs1 l)
725− FL.Done fb -> return $ Done n fb
675+ return $ Partial n (ManyTillR 0 s l)
676+ FL.Done b1 -> return $ Done n b1
726677 Error err -> return $ Error err
727678
728679 extract (ManyTillL _ fs sR) = do
729680 res <- extractL sR >>= fstep fs
730681 case res of
731− FL.Partial sres -> fextract sres
732− FL.Done bres -> return bres
682+ FL.Partial s -> fextract s
683+ FL.Done b -> return b
733684 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
122122
123123 , die
124124 , dieM
125− , splitSome
126− , splitMany
125+ , splitSome -- parseSome?
126+ , splitMany -- parseMany?
127127 , alt
128128 , concatMap
129129 )
@@ -274,6 +274,8 @@ yieldM b = Parser (\_ _ -> Done 1 <$> b) -- step
274274{-# ANN type SeqParseState Fuse #-}
275275data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
276276
277+-- | See 'Streamly.Internal.Data.Parser.splitWith'.
278+--
277279-- Note: this implementation of splitWith is fast because of stream fusion but
278280-- has quadratic time complexity, because each composition adds a new branch
279281-- 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
281283-- compositions the performance starts dipping rapidly beyond a CPS style
282284-- unfused implementation.
283285--
284−-- | See 'Streamly.Internal.Data.Parser.splitWith'.
285−--
286286-- /Internal/
287287--
288288{-# INLINE splitWith #-}
@@ -430,7 +430,6 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
430430 extract (AltParseR sR) = extractR sR
431431 extract (AltParseL _ sL) = extractL sL
432432
433−-- XXX We are ignoring the Error?
434433-- | See documentation of 'Streamly.Internal.Data.Parser.many'.
435434--
436435-- /Internal/
@@ -453,17 +452,14 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
453452 let cnt1 = cnt + 1
454453 case r of
455454 Partial n s -> do
456− -- XXX Combine assert with the next statement
457455 assert (cnt1 - n >= 0) (return ())
458456 return $ Continue n (Tuple3' s (cnt1 - n) fs)
459457 Continue n s -> do
460− -- XXX Combine assert with the next statement
461458 assert (cnt1 - n >= 0) (return ())
462459 return $ Continue n (Tuple3' s (cnt1 - n) fs)
463460 Done n b -> do
464461 s <- initial1
465462 fs1 <- fstep fs b
466− -- XXX Combine assert with the next statement
467463 assert (cnt1 - n >= 0) (return ())
468464 return
469465 $ case fs1 of
@@ -484,8 +480,6 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
484480 FL.Partial s1 -> fextract s1
485481 FL.Done b1 -> return b1
486482
487−-- XXX Unwrap Either into their own constructors?
488−-- XXX I think haskell automatically does this though. Need to check.
489483-- | See documentation of 'Streamly.Internal.Data.Parser.some'.
490484--
491485-- /Internal/
@@ -505,6 +499,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
505499 {-# INLINE step #-}
506500 step (Tuple3' st cnt (Left fs)) a = do
507501 r <- step1 st a
502+ -- In the Left state, count is used only for the assert
508503 let cnt1 = cnt + 1
509504 case r of
510505 Partial n s -> do
@@ -514,6 +509,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
514509 assert (cnt1 - n >= 0) (return ())
515510 return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))
516511 Done n b -> do
512+ assert (cnt1 - n >= 0) (return ())
517513 s <- initial1
518514 fs1 <- fstep fs b
519515 return
@@ -532,9 +528,9 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
532528 assert (cnt1 - n >= 0) (return ())
533529 return $ Continue n (Tuple3' s (cnt1 - n) (Right fs))
534530 Done n b -> do
531+ assert (cnt1 - n >= 0) (return ())
535532 s <- initial1
536533 fs1 <- fstep fs b
537− assert (cnt1 - n >= 0) (return ())
538534 return
539535 $ case fs1 of
540536 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
783783 -- XXX sliceSepByMax drops the separator so assumes a null
784784 -- terminated path, we should use a takeWhile nested inside a
785785 -- takeP
786− pth <- PR.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
786+ pth <-
787+ PR.fromFold
788+ $ FL.sliceSepByMax (== 0) pathLen (A.writeN pathLen)
787789 let remaining = pathLen - A.length pth - 1
788790 when (remaining /= 0) $ PR.takeEQ remaining FL.drain
789791 return pth
streamly.cabal+2
@@ -694,11 +694,13 @@ test-suite Data.Parser
694694 ghc-options: -O2
695695 type: exitcode-stdio-1.0
696696 main-is: Streamly/Test/Data/Parser.hs
697+ other-modules: Streamly.Test.Common
697698
698699test-suite Data.Parser.ParserD
699700 import: test-options
700701 type: exitcode-stdio-1.0
701702 main-is: Streamly/Test/Data/Parser/ParserD.hs
703+ other-modules: Streamly.Test.Common
702704
703705test-suite Data.Array
704706 import: test-options
test/Streamly/Test/Data/Parser.hs+21−94
@@ -1,16 +1,14 @@
11module Main (main) where
22
33import Control.Exception (SomeException(..), displayException)
4−import Control.Monad (when)
5−import Control.Monad.IO.Class (MonadIO(..))
6−import Data.List ((\\))
74import Data.Word (Word8, Word32, Word64)
5+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
86import Test.Hspec (Spec, hspec, describe)
97import Test.Hspec.QuickCheck
108import Test.QuickCheck
11− (arbitrary, forAll, choose, elements, Property, property, listOf,
12− vectorOf, counterexample, Gen, suchThat)
13−import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor, run)
9+ (arbitrary, forAll, elements, Property, property, listOf,
10+ vectorOf, Gen, suchThat)
11+import Test.QuickCheck.Monadic (monadicIO, assert, run)
1412
1513import Prelude hiding (sequence)
1614
@@ -52,30 +50,6 @@ max_value = 10000
5250max_length :: Int
5351max_length = 1000
5452
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−
7953-- Accumulator Tests
8054
8155fromFold :: Property
@@ -85,20 +59,6 @@ fromFold =
8559 Right is_equal -> is_equal
8660 Left _ -> False
8761
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−
10262yield :: Property
10363yield =
10464 forAll (chooseInt (min_value, max_value)) $ \x ->
@@ -195,14 +155,6 @@ satisfy =
195155
196156-- Sequence Parsers Tests
197157
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−
206158takeEQPass :: Property
207159takeEQPass =
208160 forAll (chooseInt (min_value, max_value)) $ \n ->
@@ -268,8 +220,6 @@ nLessThanEqual0 tk ltk =
268220takeProperties :: Spec
269221takeProperties =
270222 describe "take combinators when n <= 0/" $ do
271− prop "take n FL.toList = []" $
272− nLessThanEqual0 P.take (\_ -> const [])
273223 prop "takeEQ n FL.toList = []" $
274224 nLessThanEqual0 P.takeEQ (\_ -> const [])
275225 prop "takeGE n FL.toList xs = xs" $
@@ -350,25 +300,6 @@ takeWhile1 =
350300 where
351301 predicate = (== 0)
352302
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−
372303-- splitWithPass :: Property
373304-- splitWithPass =
374305-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
@@ -474,7 +405,8 @@ many =
474405 forAll (listOf (chooseInt (0, 1))) $ \ls ->
475406 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
476407 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
478410 in
479411 case S.parse prsr (S.fromList ls) of
480412 Right res_list -> checkListEqual res_list (Prelude.filter (== 0) ls)
@@ -492,7 +424,8 @@ some =
492424 let
493425 ls = 0 : genLs
494426 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
496429 in
497430 case S.parse prsr (S.fromList ls) of
498431 Right res_list -> res_list == Prelude.filter (== 0) ls
@@ -515,9 +448,9 @@ applicative =
515448 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
516449 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
517450 let parser =
518− (,)
519− <$> P.take (length list1) FL.toList
520− <*> P.take (length list2) FL.toList
451+ (,)
452+ <$> P.fromFold (FL.ltake (length list1) FL.toList)
453+ <*> P.fromFold (FL.ltake (length list2) FL.toList)
521454 in monadicIO $ do
522455 (olist1, olist2) <-
523456 run $ S.parse parser (S.fromList $ list1 ++ list2)
@@ -529,11 +462,11 @@ applicative =
529462sequence :: Property
530463sequence =
531464 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)
533466 in monadicIO $ do
534467 outs <- run $
535468 S.parse
536− (Prelude.sequence parsers)
469+ (Prelude.sequence $ fmap p ins)
537470 (S.fromList $ concat ins)
538471 listEquals (==) outs ins
539472
@@ -544,9 +477,9 @@ monad =
544477 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
545478 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
546479 let parser = do
547− olist1 <- P.take (length list1) FL.toList
548− olist2 <- P.take (length list2) FL.toList
549− return (olist1, olist2)
480+ olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)
481+ olist2 <- P.fromFold (FL.ltake (length list2) FL.toList)
482+ return (olist1, olist2)
550483 in monadicIO $ do
551484 (olist1, olist2) <-
552485 run $ S.parse parser (S.fromList $ list1 ++ list2)
@@ -562,12 +495,11 @@ parseMany =
562495 forAll (chooseInt (1,100)) $ \len ->
563496 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
564497 monadicIO $ do
565− outs <-
566− ( run
567− $ S.toList
568− $ S.parseMany
569− (P.take len FL.toList) (S.fromList $ concat ins)
570− )
498+ outs <- do
499+ let p = P.fromFold $ FL.ltake len FL.toList
500+ run
501+ $ S.toList
502+ $ S.parseMany p (S.fromList $ concat ins)
571503 listEquals (==) outs ins
572504
573505-------------------------------------------------------------------------------
@@ -653,8 +585,6 @@ main =
653585
654586 describe "test for accumulator" $ do
655587 prop "P.fromFold FL.sum = FL.sum" fromFold
656− prop "P.any = Prelude.any" Main.any
657− prop "P.all = Prelude.all" Main.all
658588 prop "yield value provided" yield
659589 prop "yield monadic value provided" yieldM
660590 prop "fail err = Left (SomeException (ParseError err))" parserFail
@@ -670,7 +600,6 @@ main =
670600 prop "check first element exists and satisfies predicate" satisfy
671601
672602 describe "test for sequence parser" $ do
673− prop "P.take = Prelude.take" Main.take
674603 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
675604 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ
676605 prop "P.takeGE n ls = ls when len >= n" takeGEPass
@@ -680,8 +609,6 @@ main =
680609 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
681610 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
682611 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
685612 -- prop "" splitWithPass
686613 -- prop "" splitWithFailLeft
687614 -- prop "" splitWithFailRight
test/Streamly/Test/Data/Parser/ParserD.hs+18−63
@@ -1,17 +1,14 @@
11module Main (main) where
22
33import Control.Exception (SomeException(..))
4−import Control.Monad (when)
5−import Control.Monad.IO.Class (MonadIO(..))
6−import Data.List ((\\))
74import Data.Word (Word8, Word32, Word64)
5+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
86import Test.Hspec (Spec, hspec, describe)
97import Test.Hspec.QuickCheck
108import Test.QuickCheck
11− (arbitrary, forAll, choose, elements, Property,
12− property, listOf, vectorOf, counterexample, (.&&.), Gen, suchThat)
13−import Test.QuickCheck.Monadic
14− (monadicIO, PropertyM, assert, monitor, run)
9+ (arbitrary, forAll, elements, Property,
10+ property, listOf, vectorOf, (.&&.), Gen, suchThat)
11+import Test.QuickCheck.Monadic (monadicIO, assert, run)
1512
1613import qualified Streamly.Internal.Data.Parser.ParserD as P
1714import qualified Streamly.Internal.Data.Stream.IsStream as S
@@ -52,30 +49,6 @@ max_value = 10000
5249max_length :: Int
5350max_length = 1000
5451
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−
7952-- Accumulator Tests
8053
8154fromFold :: Property
@@ -87,20 +60,6 @@ fromFold =
8760 Right is_equal -> is_equal
8861 Left _ -> False
8962
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−
10463yield :: Property
10564yield =
10665 forAll (chooseInt (min_value, max_value)) $ \x ->
@@ -192,7 +151,7 @@ take :: Property
192151take =
193152 forAll (chooseInt (min_value, max_value)) $ \n ->
194153 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
196155 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
197156 Left _ -> property False
198157
@@ -261,8 +220,6 @@ nLessThanEqual0 tk ltk =
261220takeProperties :: Spec
262221takeProperties =
263222 describe "take combinators when n <= 0/" $ do
264− prop "take n FL.toList = []" $
265− nLessThanEqual0 P.take (\_ -> const [])
266223 prop "takeEQ n FL.toList = []" $
267224 nLessThanEqual0 P.takeEQ (\_ -> const [])
268225 prop "takeGE n FL.toList xs = xs" $
@@ -275,7 +232,7 @@ lookAheadPass :: Property
275232lookAheadPass =
276233 forAll (chooseInt (min_value, max_value)) $ \n ->
277234 let
278− takeWithoutConsume = P.lookAhead $ P.take n FL.toList
235+ takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.ltake n FL.toList
279236 parseTwice = do
280237 parsed_list_1 <- takeWithoutConsume
281238 parsed_list_2 <- takeWithoutConsume
@@ -291,7 +248,7 @@ lookAhead :: Property
291248lookAhead =
292249 forAll (chooseInt (min_value, max_value)) $ \n ->
293250 let
294− takeWithoutConsume = P.lookAhead $ P.take n FL.toList
251+ takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.ltake n FL.toList
295252 parseTwice = do
296253 parsed_list_1 <- takeWithoutConsume
297254 parsed_list_2 <- takeWithoutConsume
@@ -333,7 +290,7 @@ takeWhile1 =
333290sliceSepBy :: Property
334291sliceSepBy =
335292 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
337294 Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile (not . predicate) ls)
338295 Left _ -> property False
339296 where
@@ -343,7 +300,7 @@ sliceSepByMax :: Property
343300sliceSepByMax =
344301 forAll (chooseInt (min_value, max_value)) $ \n ->
345302 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
347304 Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
348305 Left _ -> property False
349306 where
@@ -383,7 +340,7 @@ teeWithPass =
383340 forAll (chooseInt (min_value, max_value)) $ \n ->
384341 forAll (listOf (chooseInt (0, 1))) $ \ls ->
385342 let
386− prsr = P.take n FL.toList
343+ prsr = P.fromFold $ FL.ltake n FL.toList
387344 in
388345 case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of
389346 Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
@@ -480,7 +437,7 @@ many =
480437 let fldstp conL currL = return $ FL.Partial (conL ++ currL)
481438 concatFold =
482439 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
484441 in case S.parseD prsr (S.fromList ls) of
485442 Right res_list ->
486443 checkListEqual res_list (Prelude.filter (== 0) ls)
@@ -498,7 +455,7 @@ some =
498455 $ \ls ->
499456 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
500457 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
502459 in case S.parseD prsr (S.fromList ls) of
503460 Right res_list -> res_list == Prelude.filter (== 0) ls
504461 Left _ -> False
@@ -521,8 +478,8 @@ applicative =
521478 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
522479 let parser =
523480 (,)
524− <$> P.take (length list1) FL.toList
525− <*> P.take (length list2) FL.toList
481+ <$> P.fromFold (FL.ltake (length list1) FL.toList)
482+ <*> P.fromFold (FL.ltake (length list2) FL.toList)
526483 in monadicIO $ do
527484 (olist1, olist2) <-
528485 run $ S.parseD parser (S.fromList $ list1 ++ list2)
@@ -534,7 +491,7 @@ applicative =
534491sequence :: Property
535492sequence =
536493 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
538495 in monadicIO $ do
539496 outs <- run $
540497 S.parseD
@@ -549,8 +506,8 @@ monad =
549506 forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->
550507 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
551508 let parser = do
552− olist1 <- P.take (length list1) FL.toList
553− olist2 <- P.take (length list2) FL.toList
509+ olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)
510+ olist2 <- P.fromFold (FL.ltake (length list2) FL.toList)
554511 return (olist1, olist2)
555512 in monadicIO $ do
556513 (olist1, olist2) <-
@@ -571,7 +528,7 @@ parseMany =
571528 ( run
572529 $ S.toList
573530 $ S.parseManyD
574− (P.take len FL.toList) (S.fromList $ concat ins)
531+ (P.fromFold $ FL.ltake len FL.toList) (S.fromList $ concat ins)
575532 )
576533 listEquals (==) outs ins
577534
@@ -657,8 +614,6 @@ main =
657614
658615 describe "test for accumulator" $ do
659616 prop "P.fromFold FL.sum = FL.sum" fromFold
660− prop "P.any = Prelude.any" Main.any
661− prop "P.all = Prelude.all" Main.all
662617 prop "yield value provided" yield
663618 prop "yield monadic value provided" yieldM
664619 prop "always fail" die