git.iko.soy/streamly
on master help sign in
Add a chunked parser implementation
fe28607Harendra Kumar
core/src/Streamly/Internal/Data/Parser/Chunked.hsnew file+322
compare with master
unifiedsplit
@@ -0,0 +1,322 @@
1+{-# OPTIONS_GHC -Wno-orphans #-}
2+
3+-- |
4+-- Module : Streamly.Internal.Data.Parser.Chunked
5+-- Copyright : (c) 2020 Composewell Technologies
6+-- License : BSD-3-Clause
7+-- Maintainer : streamly@composewell.com
8+-- Stability : pre-release
9+-- Portability : GHC
10+
11+module Streamly.Internal.Data.Parser.Chunked
12+ (
13+ ParserChunked (..)
14+ , fromParserD
15+ , parseBreak
16+ , K.fromPure
17+ , K.fromEffect
18+ , K.die
19+
20+ -- We can expose all the parser combinators here, that way we can choose to
21+ -- use custom or CPS equivalents where it makes sense.
22+ )
23+where
24+
25+#include "ArrayMacros.h"
26+#include "assert.hs"
27+#include "inline.hs"
28+
29+import Control.Monad.Catch (MonadThrow, throwM)
30+import Control.Monad.IO.Class (MonadIO(..))
31+import GHC.Types (SPEC(..))
32+import Streamly.Internal.Data.Array.Type (Array(..))
33+import Streamly.Internal.Data.Parser.Chunked.Type (ParserChunked (..))
34+import Streamly.Internal.Data.Parser.ParserD.Type (Initial(..), Step(..))
35+import Streamly.Internal.Data.Stream.Type (Stream)
36+import Streamly.Internal.Data.SVar.Type (defState)
37+import Streamly.Internal.Data.Unboxed (peekWith, sizeOf, Unbox)
38+
39+import qualified Streamly.Internal.Data.Array as Array
40+import qualified Streamly.Internal.Data.Parser.Chunked.Type as K
41+import qualified Streamly.Internal.Data.Parser.ParserD as D
42+ hiding (fromParserK, toParserK)
43+import qualified Streamly.Internal.Data.Stream.StreamK as StreamK
44+import qualified Streamly.Internal.Data.Stream.Type as Stream
45+
46+-------------------------------------------------------------------------------
47+-- Driver
48+-------------------------------------------------------------------------------
49+
50+-- The backracking buffer consists of arrays in the most recent first order. We
51+-- want to take a total of n array elements from this buffer. Note: when we
52+-- have to take an array partially, we must take the last part of the array.
53+{-# INLINE backTrack #-}
54+backTrack :: forall m a. Unbox a =>
55+ Int
56+ -> [Array a]
57+ -> StreamK.Stream m (Array a)
58+ -> (StreamK.Stream m (Array a), [Array a])
59+backTrack = go
60+
61+ where
62+
63+ go _ [] stream = (stream, [])
64+ go n xs stream | n <= 0 = (stream, xs)
65+ go n (x:xs) stream =
66+ let len = Array.length x
67+ in if n > len
68+ then go (n - len) xs (StreamK.cons x stream)
69+ else if n == len
70+ then (StreamK.cons x stream, xs)
71+ else let !(Array contents start end) = x
72+ !start1 = end - (n * SIZE_OF(a))
73+ arr1 = Array contents start1 end
74+ arr2 = Array contents start start1
75+ in (StreamK.cons arr1 stream, arr2:xs)
76+
77+-- | A continuation to extract the result when a CPS parser is done.
78+{-# INLINE parserDone #-}
79+parserDone :: Monad m => (Int, Int) -> K.Parse b -> m (K.Step m a b)
80+parserDone (0,_) (K.Success n b) = return $ K.Done n b
81+parserDone st (K.Success _ _) =
82+ error $ "Bug: fromParserK: inside alternative: " ++ show st
83+parserDone _ (K.Failure e) = return $ K.Error e
84+
85+-- | Run a 'Parser' over a stream and return rest of the Stream.
86+{-# INLINE_NORMAL parseBreak #-}
87+parseBreak
88+ :: (MonadThrow m, Unbox a)
89+ => ParserChunked a m b
90+ -> Stream m (Array a)
91+ -> m (b, Stream m (Array a))
92+parseBreak parser input = do
93+ pRes <- K.runParser parser 0 (0,0) parserDone
94+ case pRes of
95+ K.Done n b -> assert (n == 0) (return (b, input))
96+ K.Error e -> throwM (D.ParseError e)
97+ K.Partial n parserk ->
98+ assert (n == 0) (go [] parserk (Stream.toStreamK input))
99+ K.Continue n parserk ->
100+ assert (n == 0) (go [] parserk (Stream.toStreamK input))
101+
102+ where
103+
104+ -- This is a simplified yieldk
105+ extractYieldK backBuf parserk arr stream = do
106+ pRes <- parserk (Just arr)
107+ case pRes of
108+ K.Partial 0 cont1 ->
109+ goExtract [] cont1 stream
110+ K.Partial n cont1 -> do
111+ assertM(n <= sum (map Array.length (arr:backBuf)))
112+ goExtract [] cont1 (fst $ backTrack n (arr:backBuf) stream)
113+ K.Continue 0 cont1 ->
114+ go (arr:backBuf) cont1 stream
115+ K.Continue n cont1 -> do
116+ assertM(n <= sum (map Array.length (arr:backBuf)))
117+ let (s1, backBuf1) = backTrack n (arr:backBuf) stream
118+ in go backBuf1 cont1 s1
119+ K.Done 0 b ->
120+ return (b, Stream.fromStreamK stream)
121+ K.Done n b -> do
122+ assertM(n <= sum (map Array.length (arr:backBuf)))
123+ let (s1, _) = backTrack n (arr:backBuf) stream
124+ in return (b, Stream.fromStreamK s1)
125+ K.Error err -> throwM $ D.ParseError err
126+
127+ goExtract backBuf parserk stream = do
128+ let stop = goStop backBuf parserk
129+ single a = extractYieldK backBuf parserk a StreamK.nil
130+ in StreamK.foldStream
131+ defState (extractYieldK backBuf parserk) single stop stream
132+
133+ -- This is a simplified goExtract
134+ {-# INLINE goStop #-}
135+ goStop backBuf parserk = do
136+ pRes <- parserk Nothing
137+ case pRes of
138+ -- If we stop in an alternative, it will try calling the next
139+ -- parser, the next parser may call initial returning Partial and
140+ -- then immediately we have to call extract on it.
141+ K.Partial 0 cont1 -> do
142+ goExtract [] cont1 StreamK.nil
143+ K.Partial n cont1 -> do
144+ -- error $ "Bug: parseBreak: Partial in extract, n = " ++ show n
145+ assertM(n <= sum (map Array.length backBuf))
146+ let (s1, backBuf1) = backTrack n backBuf StreamK.nil
147+ in goExtract backBuf1 cont1 s1
148+ K.Continue 0 cont1 -> do
149+ -- error "parseBreak: extract, Continue 0 creates infinite loop"
150+ go backBuf cont1 StreamK.nil
151+ K.Continue n cont1 -> do
152+ assertM(n <= sum (map Array.length backBuf))
153+ let (s1, backBuf1) = backTrack n backBuf StreamK.nil
154+ in goExtract backBuf1 cont1 s1
155+ K.Done 0 b -> return (b, Stream.nil)
156+ K.Done n b -> do
157+ assertM(n <= sum (map Array.length backBuf))
158+ let (s1, _) = backTrack n backBuf StreamK.nil
159+ in return (b, Stream.fromStreamK s1)
160+ K.Error err -> throwM $ D.ParseError err
161+
162+ -- SPECIALIZE this on backBuf?
163+ yieldk backBuf !parserk arr stream = do
164+ pRes <- parserk (Just arr)
165+ case pRes of
166+ K.Partial 0 cont1 ->
167+ go [] cont1 stream
168+ K.Partial n cont1 -> do
169+ assertM(n <= sum (map Array.length (arr:backBuf)))
170+ go [] cont1 (fst $ backTrack n (arr:backBuf) stream)
171+ K.Continue 0 cont1 ->
172+ go (arr:backBuf) cont1 stream
173+ K.Continue n cont1 -> do
174+ assertM(n <= sum (map Array.length (arr:backBuf)))
175+ let (s1, backBuf1) = backTrack n (arr:backBuf) stream
176+ in go backBuf1 cont1 s1
177+ K.Done 0 b ->
178+ return (b, Stream.fromStreamK stream)
179+ K.Done n b -> do
180+ assertM(n <= sum (map Array.length (arr:backBuf)))
181+ let (s1, _) = backTrack n (arr:backBuf) stream
182+ in return (b, Stream.fromStreamK s1)
183+ K.Error err -> throwM $ D.ParseError err
184+
185+ go backBuf parserk stream = do
186+ let stop = goStop backBuf parserk
187+ single a = yieldk backBuf parserk a StreamK.nil
188+ in StreamK.foldStream
189+ defState (yieldk backBuf parserk) single stop stream
190+
191+-- This is very similar to fromParserD in the Array/Unboxed/Fold module.
192+{-# INLINE parseChunk #-}
193+parseChunk
194+ :: forall m a s b. (MonadIO m, Unbox a)
195+ => (s -> a -> m (Step s b))
196+ -> s
197+ -> Array a
198+ -> m (Step s b)
199+parseChunk pstep state (Array contents start end) = do
200+ go SPEC start state
201+
202+ where
203+
204+ {-# INLINE partial #-}
205+ partial arrRem cur next elemSize st n fs1 = do
206+ let next1 = next - (n * elemSize)
207+ if next1 >= start && cur < end
208+ then go SPEC next1 fs1
209+ else return $ st (arrRem + n) fs1
210+
211+ go !_ !cur !pst | cur >= end = return $ Continue 0 pst
212+ go !_ !cur !pst = do
213+ x <- liftIO $ peekWith contents cur
214+ pRes <- pstep pst x
215+ let elemSize = SIZE_OF(a)
216+ next = INDEX_NEXT(cur,a)
217+ arrRem = (end - next) `div` elemSize
218+ case pRes of
219+ Done n b -> do
220+ return $ Done (arrRem + n) b
221+ Partial n pst1 ->
222+ partial arrRem cur next elemSize Partial n pst1
223+ Continue n pst1 -> do
224+ partial arrRem cur next elemSize Continue n pst1
225+ Error err -> return $ Error err
226+
227+{-# INLINE_NORMAL parseDToK #-}
228+parseDToK
229+ :: (MonadIO m, Unbox a)
230+ => (s -> a -> m (Step s b))
231+ -> m (Initial s b)
232+ -> (s -> m (Step s b))
233+ -> Int
234+ -> (Int, Int)
235+ -> ((Int, Int) -> K.Parse b -> m (K.Step m a r))
236+ -> m (K.Step m a r)
237+-- Non 'Alternative' case.
238+parseDToK pstep initial extract leftover (0, _) cont = do
239+ res <- initial
240+ case res of
241+ IPartial r -> return $ K.Partial leftover (parseCont (return r))
242+ IDone b -> cont state (K.Success 0 b)
243+ IError err -> cont state (K.Failure err)
244+
245+ where
246+
247+ -- The continuation is called with (0,0) state i.e. Alternative level
248+ -- is 0 and the used count is 0. Alternative level is 0 because the level
249+ -- passed in the argument above is 0, the "used" count is 0 because it is
250+ -- not useful when Alternative level is 0. We should probably use a Maybe
251+ -- type for the state but that might impact performance, need to measure.
252+ state = (0,0)
253+
254+ -- We could pass a stream or array here and drive the ParserD with fusion.
255+ parseCont pst (Just arr) = do
256+ r <- pst
257+ pRes <- parseChunk pstep r arr
258+ case pRes of
259+ Done n b -> cont state (K.Success n b)
260+ Error err -> cont state (K.Failure err)
261+ Partial n pst1 -> return $ K.Partial n (parseCont (return pst1))
262+ Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))
263+
264+ parseCont acc Nothing = do
265+ pst <- acc
266+ r <- extract pst
267+ case r of
268+ Done n b -> cont state (K.Success n b)
269+ Error err -> cont state (K.Failure err)
270+ Partial _ _ -> error "Bug: parseDToK Partial unreachable"
271+ Continue n pst1 -> return $ K.Continue n (parseCont (return pst1))
272+
273+-- 'Alternative' case. Used count needs to be maintained when inside an
274+-- Alternative.
275+parseDToK pstep initial extract leftover (level, count) cont = do
276+ res <- initial
277+ case res of
278+ IPartial r -> return $ K.Partial leftover (parseCont count (return r))
279+ IDone b -> cont (level,count) (K.Success 0 b)
280+ IError err -> cont (level,count) (K.Failure err)
281+
282+ where
283+
284+ parseCont !cnt pst (Just arr) = do
285+ let !cnt1 = cnt + Array.length arr
286+ r <- pst
287+ pRes <- parseChunk pstep r arr
288+ case pRes of
289+ Done n b -> do
290+ assertM(n <= cnt1)
291+ cont (level, cnt1 - n) (K.Success n b)
292+ Error err ->
293+ cont (level, cnt1) (K.Failure err)
294+ Partial n pst1 -> do
295+ assertM(n <= cnt1)
296+ return $ K.Partial n (parseCont (cnt1 - n) (return pst1))
297+ Continue n pst1 -> do
298+ assertM(n <= cnt1)
299+ return $ K.Continue n (parseCont (cnt1 - n) (return pst1))
300+ parseCont cnt acc Nothing = do
301+ pst <- acc
302+ r <- extract pst
303+ let s = (level, cnt)
304+ case r of
305+ Done n b -> do
306+ assertM(n <= cnt)
307+ cont s (K.Success n b)
308+ Partial _ _ -> error "Bug: parseDToK Partial unreachable"
309+ Error e ->
310+ cont s (K.Failure e)
311+ Continue n pst1 -> do
312+ assertM(n <= cnt)
313+ return $ K.Continue n (parseCont (cnt - n) (return pst1))
314+
315+-- | Convert a raw byte 'Parser' to a chunked parser.
316+--
317+-- /Pre-release/
318+--
319+{-# INLINE_LATE fromParserD #-}
320+fromParserD :: (MonadIO m, Unbox a) => D.Parser a m b -> ParserChunked a m b
321+fromParserD (D.Parser step initial extract) =
322+ K.MkParser $ parseDToK step initial extract
core/src/Streamly/Internal/Data/Parser/Chunked/Type.hsnew file+332
@@ -0,0 +1,332 @@
1+{-# LANGUAGE UndecidableInstances #-}
2+#include "inline.hs"
3+
4+-- |
5+-- Module : Streamly.Internal.Data.Parser.Chunked.Type
6+-- Copyright : (c) 2020 Composewell Technologies
7+-- License : BSD-3-Clause
8+-- Maintainer : streamly@composewell.com
9+-- Stability : experimental
10+-- Portability : GHC
11+--
12+-- CPS style implementation of parsers.
13+--
14+-- The CPS representation allows linear performance for Applicative, sequenceA,
15+-- Monad, sequence, and Alternative, choice operations compared to the
16+-- quadratic complexity of the corresponding direct style operations. However,
17+-- direct style operations allow fusion with ~10x better performance than CPS.
18+--
19+-- The direct style representation does not allow for recursive definitions of
20+-- "some" and "many" whereas CPS allows that.
21+
22+-- XXX This code has only one line difference from the
23+-- Data.Parser.ParserK/Type.
24+
25+module Streamly.Internal.Data.Parser.Chunked.Type
26+ (
27+ Step (..)
28+ , Parse (..)
29+ , ParserChunked (..)
30+ , fromPure
31+ , fromEffect
32+ , die
33+ )
34+where
35+
36+import Control.Applicative (Alternative(..), liftA2)
37+import Control.Monad (MonadPlus(..), ap)
38+import Control.Monad.Catch (MonadCatch, MonadThrow(..))
39+import Control.Monad.IO.Class (MonadIO, liftIO)
40+import Control.Monad.Reader.Class (MonadReader, ask, local)
41+import Control.Monad.State.Class (MonadState, get, put)
42+import Streamly.Internal.Data.Array (Array)
43+import qualified Control.Monad.Fail as Fail
44+
45+-- | The intermediate result of running a parser step. The parser driver may
46+-- stop with a final result, pause with a continuation to resume, or fail with
47+-- an error.
48+--
49+-- See ParserD docs. This is the same as the ParserD Step except that it uses a
50+-- continuation in Partial and Continue constructors instead of a state in case
51+-- of ParserD.
52+--
53+-- /Pre-release/
54+--
55+data Step m a r =
56+ Done !Int r
57+ -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
58+ -- measure if that works any better.
59+ -- XXX The Array is the only difference from element parser, we can pass
60+ -- this as parameter?
61+ | Partial !Int (Maybe (Array a) -> m (Step m a r))
62+ | Continue !Int (Maybe (Array a) -> m (Step m a r))
63+ | Error String
64+
65+instance Functor m => Functor (Step m a) where
66+ fmap f (Done n r) = Done n (f r)
67+ fmap f (Partial n k) = Partial n (fmap (fmap f) . k)
68+ fmap f (Continue n k) = Continue n (fmap (fmap f) . k)
69+ fmap _ (Error e) = Error e
70+
71+-- | The parser's result.
72+--
73+-- /Pre-release/
74+--
75+data Parse b =
76+ Success !Int !b -- Leftover count, result
77+ | Failure !String -- Error
78+
79+-- | Map a function over 'Success'.
80+instance Functor Parse where
81+ fmap f (Success n b) = Success n (f b)
82+ fmap _ (Failure e) = Failure e
83+
84+-- | A continuation passing style parser representation. A continuation of
85+-- 'Step's, each step passes a state and a parse result to the next 'Step'. The
86+-- resulting 'Step' may carry a continuation that consumes input 'a' and
87+-- results in another 'Step'. Essentially, the continuation may either consume
88+-- input without a result or return a result with no further input to be
89+-- consumed.
90+--
91+newtype ParserChunked a m b = MkParser
92+ { runParser :: forall r.
93+ -- leftover: the number of elements that were not used by the
94+ -- previous consumer and should be carried forward.
95+ Int
96+ -- (alt nesting level, alt used elem count). Nesting level is
97+ -- increased whenever we enter an Alternative composition and
98+ -- decreased when it is done. The used element count is a count of
99+ -- elements consumed by the Alternative. If the Alternative fails we
100+ -- need to backtrack by this amount.
101+ --
102+ -- The nesting level is used in parseDToK to optimize the case when
103+ -- we are not in an alternative, in that case we do not need to
104+ -- maintain the element count for backtracking.
105+ -> (Int, Int)
106+ -- The first argument is the (nest level, used count) tuple as
107+ -- described above. The leftover element count is carried as part of
108+ -- 'Success' constructor of 'Parse'.
109+ -> ((Int, Int) -> Parse b -> m (Step m a r))
110+ -> m (Step m a r)
111+ }
112+
113+-------------------------------------------------------------------------------
114+-- Functor
115+-------------------------------------------------------------------------------
116+
117+-- XXX rewrite this using ParserD, expose rmapM from ParserD.
118+-- | Maps a function over the output of the parser.
119+--
120+instance Functor m => Functor (ParserChunked a m) where
121+ {-# INLINE fmap #-}
122+ fmap f parser = MkParser $ \n st k ->
123+ let k1 s res = k s (fmap f res)
124+ in runParser parser n st k1
125+
126+-------------------------------------------------------------------------------
127+-- Sequential applicative
128+-------------------------------------------------------------------------------
129+
130+-- This is the dual of stream "fromPure".
131+--
132+-- | A parser that always yields a pure value without consuming any input.
133+--
134+-- /Pre-release/
135+--
136+{-# INLINE fromPure #-}
137+fromPure :: b -> ParserChunked a m b
138+fromPure b = MkParser $ \n st k -> k st (Success n b)
139+
140+-- | See 'Streamly.Internal.Data.Parser.fromEffect'.
141+--
142+-- /Pre-release/
143+--
144+{-# INLINE fromEffect #-}
145+fromEffect :: Monad m => m b -> ParserChunked a m b
146+fromEffect eff = MkParser $ \n st k -> eff >>= \b -> k st (Success n b)
147+
148+-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.serialWith'. Note that
149+-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.serialWith'
150+-- when fusion is important.
151+--
152+instance Monad m => Applicative (ParserChunked a m) where
153+ {-# INLINE pure #-}
154+ pure = fromPure
155+
156+ {-# INLINE (<*>) #-}
157+ (<*>) = ap
158+
159+ {-# INLINE (*>) #-}
160+ p1 *> p2 = MkParser $ \n st k ->
161+ let k1 s (Success n1 _) = runParser p2 n1 s k
162+ k1 s (Failure e) = k s (Failure e)
163+ in runParser p1 n st k1
164+
165+ {-# INLINE (<*) #-}
166+ p1 <* p2 = MkParser $ \n st k ->
167+ let k1 s1 (Success n1 b) =
168+ let k2 s2 (Success n2 _) = k s2 (Success n2 b)
169+ k2 s2 (Failure e) = k s2 (Failure e)
170+ in runParser p2 n1 s1 k2
171+ k1 s1 (Failure e) = k s1 (Failure e)
172+ in runParser p1 n st k1
173+
174+ {-# INLINE liftA2 #-}
175+ liftA2 f p = (<*>) (fmap f p)
176+
177+-------------------------------------------------------------------------------
178+-- Monad
179+-------------------------------------------------------------------------------
180+
181+-- This is the dual of "nil".
182+--
183+-- | A parser that always fails with an error message without consuming
184+-- any input.
185+--
186+-- /Pre-release/
187+--
188+{-# INLINE die #-}
189+die :: String -> ParserChunked a m b
190+die err = MkParser (\_ st k -> k st (Failure err))
191+
192+-- | Monad composition can be used for lookbehind parsers, we can make the
193+-- future parses depend on the previously parsed values.
194+--
195+-- If we have to parse "a9" or "9a" but not "99" or "aa" we can use the
196+-- following parser:
197+--
198+-- @
199+-- backtracking :: MonadCatch m => PR.Parser Char m String
200+-- backtracking =
201+-- sequence [PR.satisfy isDigit, PR.satisfy isAlpha]
202+-- '<|>'
203+-- sequence [PR.satisfy isAlpha, PR.satisfy isDigit]
204+-- @
205+--
206+-- We know that if the first parse resulted in a digit at the first place then
207+-- the second parse is going to fail. However, we waste that information and
208+-- parse the first character again in the second parse only to know that it is
209+-- not an alphabetic char. By using lookbehind in a 'Monad' composition we can
210+-- avoid redundant work:
211+--
212+-- @
213+-- data DigitOrAlpha = Digit Char | Alpha Char
214+--
215+-- lookbehind :: MonadCatch m => PR.Parser Char m String
216+-- lookbehind = do
217+-- x1 \<- Digit '<$>' PR.satisfy isDigit
218+-- '<|>' Alpha '<$>' PR.satisfy isAlpha
219+--
220+-- -- Note: the parse depends on what we parsed already
221+-- x2 <- case x1 of
222+-- Digit _ -> PR.satisfy isAlpha
223+-- Alpha _ -> PR.satisfy isDigit
224+--
225+-- return $ case x1 of
226+-- Digit x -> [x,x2]
227+-- Alpha x -> [x,x2]
228+-- @
229+--
230+-- See also 'Streamly.Internal.Data.Parser.concatMap'. This monad instance
231+-- does not fuse, use 'Streamly.Internal.Data.Parser.concatMap' when you need
232+-- fusion.
233+--
234+instance Monad m => Monad (ParserChunked a m) where
235+ {-# INLINE return #-}
236+ return = pure
237+
238+ {-# INLINE (>>=) #-}
239+ p >>= f = MkParser $ \n st k ->
240+ let k1 s1 (Success n1 b) = runParser (f b) n1 s1 k
241+ k1 s1 (Failure e) = k s1 (Failure e)
242+ in runParser p n st k1
243+
244+ {-# INLINE (>>) #-}
245+ (>>) = (*>)
246+
247+#if !(MIN_VERSION_base(4,13,0))
248+ -- This is redefined instead of just being Fail.fail to be
249+ -- compatible with base 4.8.
250+ {-# INLINE fail #-}
251+ fail = die
252+#endif
253+instance Monad m => Fail.MonadFail (ParserChunked a m) where
254+ {-# INLINE fail #-}
255+ fail = die
256+
257+instance (MonadThrow m, MonadReader r m, MonadCatch m) =>
258+ MonadReader r (ParserChunked a m) where
259+
260+ {-# INLINE ask #-}
261+ ask = fromEffect ask
262+
263+ {-# INLINE local #-}
264+ local f p = MkParser $ \n st k -> local f $ runParser p n st k
265+
266+instance (MonadThrow m, MonadState s m) => MonadState s (ParserChunked a m) where
267+ {-# INLINE get #-}
268+ get = fromEffect get
269+
270+ {-# INLINE put #-}
271+ put = fromEffect . put
272+
273+instance (MonadThrow m, MonadIO m) => MonadIO (ParserChunked a m) where
274+ {-# INLINE liftIO #-}
275+ liftIO = fromEffect . liftIO
276+
277+-------------------------------------------------------------------------------
278+-- Alternative
279+-------------------------------------------------------------------------------
280+
281+-- | 'Alternative' form of 'Streamly.Internal.Data.Parser.alt'. Backtrack and
282+-- run the second parser if the first one fails.
283+--
284+-- The "some" and "many" operations of alternative accumulate results in a pure
285+-- list which is not scalable and streaming. Instead use
286+-- 'Streamly.Internal.Data.Parser.some' and
287+-- 'Streamly.Internal.Data.Parser.many' for fusible operations with composable
288+-- accumulation of results.
289+--
290+-- See also 'Streamly.Internal.Data.Parser.alt'. This 'Alternative' instance
291+-- does not fuse, use 'Streamly.Internal.Data.Parser.alt' when you need
292+-- fusion.
293+--
294+instance Monad m => Alternative (ParserChunked a m) where
295+ {-# INLINE empty #-}
296+ empty = die "empty"
297+
298+ {-# INLINE (<|>) #-}
299+ p1 <|> p2 = MkParser $ \n (level, _) k ->
300+ let k1 (0, _) _ = error "Bug: 0 nest level in Alternative"
301+ k1 (l1, n1) (Failure _) = runParser p2 n1 (l1 - 1, 0) k
302+ k1 (l1, _) success = k (l1 - 1, 0) success
303+ in runParser p1 n (level + 1, 0) k1
304+
305+ -- some and many are implemented here instead of using default definitions
306+ -- so that we can use INLINE on them. It gives 50% performance improvement.
307+
308+ {-# INLINE many #-}
309+ many v = many_v
310+
311+ where
312+
313+ many_v = some_v <|> pure []
314+ some_v = (:) <$> v <*> many_v
315+
316+ {-# INLINE some #-}
317+ some v = some_v
318+
319+ where
320+
321+ many_v = some_v <|> pure []
322+ some_v = (:) <$> v <*> many_v
323+
324+-- | 'mzero' is same as 'empty', it aborts the parser. 'mplus' is same as
325+-- '<|>', it selects the first succeeding parser.
326+--
327+instance Monad m => MonadPlus (ParserChunked a m) where
328+ {-# INLINE mzero #-}
329+ mzero = die "mzero"
330+
331+ {-# INLINE mplus #-}
332+ mplus = (<|>)
core/streamly-core.cabal+2
@@ -301,6 +301,8 @@ library
301 , Streamly.Internal.Data.Fold.Chunked
301 , Streamly.Internal.Data.Fold.Chunked
302 , Streamly.Internal.Data.Fold.Window
302 , Streamly.Internal.Data.Fold.Window
303 , Streamly.Internal.Data.Parser
303 , Streamly.Internal.Data.Parser
304+ , Streamly.Internal.Data.Parser.Chunked.Type
305+ , Streamly.Internal.Data.Parser.Chunked
304 , Streamly.Internal.Data.Pipe
306 , Streamly.Internal.Data.Pipe
305 , Streamly.Internal.Data.Stream.Type
307 , Streamly.Internal.Data.Stream.Type
306 , Streamly.Internal.Data.Stream.Eliminate
308 , Streamly.Internal.Data.Stream.Eliminate
hie.yaml+2
@@ -96,6 +96,8 @@ cradle:
96 component: "test:Data.Stream.Concurrent"
96 component: "test:Data.Stream.Concurrent"
97 - path: "./test/Streamly/Test/Data/Stream/Common.hs"
97 - path: "./test/Streamly/Test/Data/Stream/Common.hs"
98 component: "test:Data.Stream.Concurrent"
98 component: "test:Data.Stream.Concurrent"
99+ - path: "./test/Streamly/Test/Data/Parser/Chunked.hs"
100+ component: "test:Data.Parser.Chunked"
99 - path: "./test/Streamly/Test/Data/Parser/ParserD.hs"
101 - path: "./test/Streamly/Test/Data/Parser/ParserD.hs"
100 component: "test:Data.Parser.ParserD"
102 component: "test:Data.Parser.ParserD"
101 - path: "./test/Streamly/Test/Data/Unfold.hs"
103 - path: "./test/Streamly/Test/Data/Unfold.hs"
streamly.cabal+1
@@ -98,6 +98,7 @@ extra-source-files:
98 test/Streamly/Test/Data/Ring/Unboxed.hs
98 test/Streamly/Test/Data/Ring/Unboxed.hs
99 test/Streamly/Test/Data/Array/Stream.hs
99 test/Streamly/Test/Data/Array/Stream.hs
100 test/Streamly/Test/Data/Parser/ParserD.hs
100 test/Streamly/Test/Data/Parser/ParserD.hs
101+ test/Streamly/Test/Data/Parser/Chunked.hs
101 test/Streamly/Test/Data/Stream/Concurrent.hs
102 test/Streamly/Test/Data/Stream/Concurrent.hs
102 test/Streamly/Test/FileSystem/Event.hs
103 test/Streamly/Test/FileSystem/Event.hs
103 test/Streamly/Test/FileSystem/Event/Common.hs
104 test/Streamly/Test/FileSystem/Event/Common.hs
test/Streamly/Test/Data/Parser/Chunked.hsnew file+1237
@@ -0,0 +1,1237 @@
1+module Main (main) where
2+
3+import Control.Monad.Catch (MonadThrow)
4+-- import Control.Exception (SomeException(..), displayException, try)
5+-- import Data.Foldable (for_)
6+-- import Data.Word (Word8, Word32, Word64)
7+import Streamly.Internal.Data.Unboxed (Unbox)
8+import Streamly.Test.Common (listEquals)
9+import Test.Hspec (hspec, describe)
10+import Test.Hspec.QuickCheck
11+import Test.QuickCheck
12+ (forAll, Property, listOf,
13+ Gen)
14+import Test.QuickCheck.Monadic (monadicIO, run)
15+
16+import Prelude hiding (sequence)
17+
18+-- import qualified Data.List as List
19+-- import qualified Prelude
20+import qualified Streamly.Internal.Data.Array as A
21+import qualified Streamly.Internal.Data.Fold as FL
22+import qualified Streamly.Internal.Data.Parser.Chunked as P
23+import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
24+import qualified Streamly.Internal.Data.Stream as S
25+import qualified Test.Hspec as H
26+
27+#if MIN_VERSION_QuickCheck(2,14,0)
28+
29+import Test.QuickCheck (chooseAny)
30+
31+#else
32+
33+import System.Random (Random(random))
34+import Test.QuickCheck.Gen (Gen(MkGen))
35+
36+-- | Generates a random element over the natural range of `a`.
37+chooseAny :: Random a => Gen a
38+chooseAny = MkGen (\r _ -> let (x,_) = random r in x)
39+
40+#endif
41+
42+maxTestCount :: Int
43+maxTestCount = 100
44+
45+{-
46+min_value :: Int
47+min_value = 0
48+
49+mid_value :: Int
50+mid_value = 5000
51+
52+max_value :: Int
53+max_value = 10000
54+
55+max_length :: Int
56+max_length = 1000
57+
58+-- Accumulator Tests
59+
60+fromFold :: Property
61+fromFold =
62+ forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
63+ case (==) <$> S.parse (P.fromFold FL.sum) (S.fromList ls)
64+ <*> S.fold FL.sum (S.fromList ls) of
65+ Right is_equal -> is_equal
66+ Left _ -> False
67+
68+fromPure :: Property
69+fromPure =
70+ forAll (chooseInt (min_value, max_value)) $ \x ->
71+ case S.parse (P.fromPure x) (S.fromList [1 :: Int]) of
72+ Right r -> r == x
73+ Left _ -> False
74+
75+fromEffect :: Property
76+fromEffect =
77+ forAll (chooseInt (min_value, max_value)) $ \x ->
78+ case S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of
79+ Right r -> r == x
80+ Left _ -> False
81+
82+die :: Property
83+die =
84+ property $
85+ case S.parse (P.die "die test") (S.fromList [0 :: Int]) of
86+ Right _ -> False
87+ Left _ -> True
88+
89+dieM :: Property
90+dieM =
91+ property $
92+ case S.parse (P.dieM (Right "die test")) (S.fromList [0 :: Int]) of
93+ Right _ -> False
94+ Left _ -> True
95+
96+parserFail :: Property
97+parserFail =
98+ property $
99+ case S.parse (fail err) (S.fromList [0 :: Int]) of
100+ Right _ -> False
101+ Left (SomeException e) -> err == displayException e
102+ where
103+ err = "Testing MonadFail.fail."
104+
105+-- Element Parser Tests
106+
107+peekPass :: Property
108+peekPass =
109+ forAll (chooseInt (1, max_length)) $ \list_length ->
110+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
111+ case S.parse P.peek (S.fromList ls) of
112+ Right head_value -> case ls of
113+ head_ls : _ -> head_value == head_ls
114+ _ -> False
115+ Left _ -> False
116+
117+peekFail :: Property
118+peekFail =
119+ property (case S.parse P.peek (S.fromList []) of
120+ Right _ -> False
121+ Left _ -> True)
122+
123+eofPass :: Property
124+eofPass =
125+ property (case S.parse P.eof (S.fromList []) of
126+ Right _ -> True
127+ Left _ -> False)
128+
129+eofFail :: Property
130+eofFail =
131+ forAll (chooseInt (1, max_length)) $ \list_length ->
132+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
133+ case S.parse P.eof (S.fromList ls) of
134+ Right _ -> False
135+ Left _ -> True
136+
137+satisfyPass :: Property
138+satisfyPass =
139+ forAll (chooseInt (mid_value, max_value)) $ \first_element ->
140+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->
141+ let
142+ ls = first_element : ls_tail
143+ predicate = (>= mid_value)
144+ in
145+ case S.parse (P.satisfy predicate) (S.fromList ls) of
146+ Right r -> r == first_element
147+ Left _ -> False
148+
149+satisfy :: Property
150+satisfy =
151+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
152+ case S.parse (P.satisfy predicate) (S.fromList ls) of
153+ Right r -> case ls of
154+ [] -> False
155+ (x : _) -> predicate x && (r == x)
156+ Left _ -> case ls of
157+ [] -> True
158+ (x : _) -> not $ predicate x
159+ where
160+ predicate = (>= mid_value)
161+
162+onePass :: Property
163+onePass =
164+ forAll (chooseInt (1, max_value)) $ \int ->
165+ property (case S.parse P.one (S.fromList [int]) of
166+ Right i -> i == int
167+ Left _ -> False)
168+
169+one :: Property
170+one =
171+ property (case S.parse P.one (S.fromList []) of
172+ Left _ -> True
173+ Right _ -> False)
174+
175+-- Sequence Parsers Tests
176+takeBetweenPass :: Property
177+takeBetweenPass =
178+ forAll (chooseInt (min_value, max_value)) $ \m ->
179+ forAll (chooseInt (m, max_value)) $ \n ->
180+ forAll (chooseInt (m, max_value)) $ \list_length ->
181+ forAll (vectorOf list_length (chooseInt (min_value, max_value)))
182+ $ \ls ->
183+ case S.parse (P.takeBetween m n FL.toList)
184+ (S.fromList ls) of
185+ Right parsed_list ->
186+ let lpl = Prelude.length parsed_list
187+ in checkListEqual parsed_list
188+ $ Prelude.take lpl ls
189+ Left _ -> property False
190+
191+takeBetween :: Property
192+takeBetween =
193+ forAll (chooseInt (min_value, max_value)) $ \m ->
194+ forAll (chooseInt (min_value, max_value)) $ \n ->
195+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
196+ go m n ls
197+
198+ where
199+
200+ go m n ls =
201+ let inputLen = Prelude.length ls
202+ in monadicIO $ do
203+ let p = P.takeBetween m n FL.toList
204+ r <- run $ try $ S.parse p (S.fromList ls)
205+ return $ case r of
206+ Right xs ->
207+ let parsedLen = Prelude.length xs
208+ in if inputLen >= m && parsedLen >= m && parsedLen <= n
209+ then checkListEqual xs $ Prelude.take parsedLen ls
210+ else property False
211+ Left (_ :: SomeException) ->
212+ property ((m >= 0 && n >= 0 && m > n) || inputLen < m)
213+
214+takeEQPass :: Property
215+takeEQPass =
216+ forAll (chooseInt (min_value, max_value)) $ \n ->
217+ forAll (chooseInt (n, max_value)) $ \list_length ->
218+ forAll (vectorOf list_length
219+ (chooseInt (min_value, max_value))) $ \ls ->
220+ case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
221+ Right parsed_list ->
222+ checkListEqual parsed_list (Prelude.take n ls)
223+ Left _ -> property False
224+
225+takeEQ :: Property
226+takeEQ =
227+ forAll (chooseInt (min_value, max_value)) $ \n ->
228+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
229+ let
230+ list_length = Prelude.length ls
231+ in
232+ case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
233+ Right parsed_list ->
234+ if n <= list_length
235+ then checkListEqual parsed_list (Prelude.take n ls)
236+ else property False
237+ Left _ -> property (n > list_length)
238+
239+takeGEPass :: Property
240+takeGEPass =
241+ forAll (chooseInt (min_value, max_value)) $ \n ->
242+ forAll (chooseInt (n, max_value)) $ \list_length ->
243+ forAll (vectorOf list_length (chooseInt (min_value, max_value)))
244+ $ \ls ->
245+ case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
246+ Right parsed_list -> checkListEqual parsed_list ls
247+ Left _ -> property False
248+
249+takeGE :: Property
250+takeGE =
251+ forAll (chooseInt (min_value, max_value)) $ \n ->
252+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
253+ let
254+ list_length = Prelude.length ls
255+ in
256+ case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
257+ Right parsed_list ->
258+ if n <= list_length
259+ then checkListEqual parsed_list ls
260+ else property False
261+ Left _ -> property (n > list_length)
262+
263+nLessThanEqual0 ::
264+ ( Int
265+ -> FL.Fold (Either SomeException) Int [Int]
266+ -> P.Parser Int (Either SomeException) [Int]
267+ )
268+ -> (Int -> [Int] -> [Int])
269+ -> Property
270+nLessThanEqual0 tk ltk =
271+ forAll (elements [0, (-1)]) $ \n ->
272+ forAll (listOf arbitrary) $ \ls ->
273+ case S.parse (tk n FL.toList) (S.fromList ls) of
274+ Right parsed_list -> checkListEqual parsed_list (ltk n ls)
275+ Left _ -> property False
276+
277+takeProperties :: Spec
278+takeProperties =
279+ describe "take combinators when n <= 0/" $ do
280+ prop "takeEQ n FL.toList = []" $
281+ nLessThanEqual0 P.takeEQ (\_ -> const [])
282+ prop "takeGE n FL.toList xs = xs" $
283+ nLessThanEqual0 P.takeGE (\_ -> id)
284+
285+-- lookAheadPass :: Property
286+-- lookAheadPass =
287+-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
288+-- let
289+-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
290+-- parseTwice = do
291+-- parsed_list_1 <- takeWithoutConsume
292+-- parsed_list_2 <- takeWithoutConsume
293+-- return (parsed_list_1, parsed_list_2)
294+-- in
295+-- forAll (chooseInt (n, max_value)) $ \list_length ->
296+-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
297+-- case S.parse parseTwice (S.fromList ls) of
298+-- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
299+-- Left _ -> property $ False
300+
301+-- lookAheadFail :: Property
302+-- lookAheadFail =
303+-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
304+-- let
305+-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
306+-- parseTwice = do
307+-- parsed_list_1 <- takeWithoutConsume
308+-- parsed_list_2 <- takeWithoutConsume
309+-- return (parsed_list_1, parsed_list_2)
310+-- in
311+-- forAll (chooseInt (min_value, n - 1)) $ \list_length ->
312+-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
313+-- case S.parse parseTwice (S.fromList ls) of
314+-- Right _ -> False
315+-- Left _ -> True
316+
317+-- lookAhead :: Property
318+-- lookAhead =
319+-- forAll (chooseInt (min_value, max_value)) $ \n ->
320+-- let
321+-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
322+-- parseTwice = do
323+-- parsed_list_1 <- takeWithoutConsume
324+-- parsed_list_2 <- takeWithoutConsume
325+-- return (parsed_list_1, parsed_list_2)
326+-- in
327+-- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
328+-- case S.parse parseTwice (S.fromList ls) of
329+-- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
330+-- Left _ -> property ((list_length < n) || (list_length == n && n == 0))
331+-- where
332+-- list_length = Prelude.length ls
333+
334+takeEndBy_ :: Property
335+takeEndBy_ =
336+ forAll (listOf (chooseInt (min_value, max_value ))) $ \ls ->
337+ case S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of
338+ Right parsed_list ->
339+ checkListEqual parsed_list (tkwhl ls)
340+ Left _ -> property False
341+ where
342+ predicate = (>= 100)
343+ prsr = P.many (P.satisfy (const True)) FL.toList
344+ tkwhl ls = Prelude.takeWhile (not . predicate) ls
345+
346+takeStartBy :: Property
347+takeStartBy =
348+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
349+ let ls1 = 1:ls
350+ in
351+ case S.parse parser (S.fromList ls1) of
352+ Right parsed_list ->
353+ if not $ Prelude.null ls1
354+ then
355+ let tls = Prelude.takeWhile (not . predicate) (tail ls1)
356+ in checkListEqual parsed_list $
357+ if predicate (head ls1)
358+ then head ls1 : tls
359+ else Prelude.takeWhile (not . predicate) ls1
360+ else property $ Prelude.null parsed_list
361+ Left _ -> property False
362+ where
363+ predicate = odd
364+ parser = P.takeStartBy predicate FL.toList
365+
366+takeWhile :: Property
367+takeWhile =
368+ forAll (listOf (chooseInt (0, 1))) $ \ ls ->
369+ case S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of
370+ Right parsed_list ->
371+ checkListEqual parsed_list (Prelude.takeWhile predicate ls)
372+ Left _ -> property False
373+ where
374+ predicate = (== 0)
375+
376+takeP :: Property
377+takeP =
378+ forAll
379+ ((,) <$> chooseInt (min_value, max_value)
380+ <*> listOf (chooseInt (0, 1)))
381+ $ \(takeNum, ls) ->
382+ case S.parse
383+ (P.takeP takeNum (P.fromFold FL.toList))
384+ (S.fromList ls) of
385+ Right parsed_list ->
386+ checkListEqual parsed_list (Prelude.take takeNum ls)
387+ Left _ -> property False
388+
389+takeWhile1 :: Property
390+takeWhile1 =
391+ forAll (listOf (chooseInt (0, 1))) $ \ ls ->
392+ case S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
393+ Right parsed_list -> case ls of
394+ [] -> property False
395+ (x : _) ->
396+ if predicate x
397+ then
398+ checkListEqual parsed_list
399+ $ Prelude.takeWhile predicate ls
400+ else
401+ property False
402+ Left _ -> case ls of
403+ [] -> property True
404+ (x : _) -> property (not $ predicate x)
405+ where
406+ predicate = (== 0)
407+
408+takeWhileP :: Property
409+takeWhileP =
410+ forAll (listOf (chooseInt (0, 1))) $ \ls ->
411+ forAll (chooseInt (min_value, max_value)) $ \n ->
412+ let
413+ predicate = (== 1)
414+
415+ prsr =
416+ P.takeWhileP predicate
417+ $ P.fromFold (FL.take n FL.toList)
418+
419+ takeWhileTillLen maxLen prd list =
420+ Prelude.take maxLen $ Prelude.takeWhile prd list
421+ in
422+ case S.parse prsr (S.fromList ls) of
423+ Right parsed_list ->
424+ checkListEqual
425+ parsed_list
426+ (takeWhileTillLen n predicate ls)
427+ Left _ -> property False
428+
429+{-
430+choice :: Property
431+choice =
432+ forAll
433+ ((,,) <$> chooseInt (min_value, max_value)
434+ <*> chooseInt (min_value, max_value)
435+ <*> listOf (chooseInt (0, 1)))
436+ $ \(i, j, ls) ->
437+ case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of
438+ Right parsed_list ->
439+ checkListEqual parsed_list $ take (min i j) ls
440+ Left _ -> property False
441+
442+ where
443+
444+ parser i = P.fromFold (FL.take i FL.toList)
445+-}
446+
447+groupBy :: Property
448+groupBy =
449+ forAll (listOf (chooseInt (0, 1)))
450+ $ \ls ->
451+ case S.parse parser (S.fromList ls) of
452+ Right parsed -> checkListEqual parsed (groupByLF ls)
453+ Left _ -> property False
454+
455+ where
456+
457+ cmp = (==)
458+ parser = P.groupBy cmp FL.toList
459+ groupByLF lst
460+ | null lst = []
461+ | otherwise = head $ List.groupBy cmp lst
462+
463+wordBy :: Property
464+wordBy =
465+ forAll (listOf (elements [' ', 's']))
466+ $ \ls ->
467+ case S.parse parser (S.fromList ls) of
468+ Right parsed -> checkListEqual parsed (words' ls)
469+ Left _ -> property False
470+
471+ where
472+
473+ predicate = (== ' ')
474+ parser = P.many (P.wordBy predicate FL.toList) FL.toList
475+ words' lst =
476+ let wrds = words lst
477+ in if wrds == [] && length lst > 0 then [""] else wrds
478+
479+parseManyWordQuotedBy :: H.SpecWith ()
480+parseManyWordQuotedBy =
481+ describe "parseMany wordQuotedBy"
482+ $ for_ testCases
483+ $ \c@(kQ, lQ, rQ, fromLQ, input, expected) -> do
484+ let inpStrm = S.fromList input
485+
486+ esc '\\' = True
487+ esc _ = False
488+
489+ spc ' ' = True
490+ spc _ = False
491+
492+ parser = P.wordQuotedBy kQ esc lQ rQ fromLQ spc FL.toList
493+ result <- H.runIO $ S.fold FL.toList $ S.parseMany parser inpStrm
494+ H.it (showCase c) $ result `H.shouldBe` expected
495+
496+ where
497+
498+ showCase (kQ, _, _, _, input, expected) =
499+ show kQ ++ ", " ++ input ++ " -> " ++ show expected
500+
501+ testCases =
502+ [ ( True
503+ , (== '\'')
504+ , (== '\'')
505+ , id
506+ , "The quick brown fox"
507+ , ["The", "quick", "brown", "fox"])
508+ , ( True
509+ , (== '\'')
510+ , (== '\'')
511+ , id
512+ , "The' quick brown' fox"
513+ , ["The' quick brown'", "fox"])
514+ , ( False
515+ , (== '\'')
516+ , (== '\'')
517+ , id
518+ , "The' quick brown' fox"
519+ , ["The quick brown", "fox"])
520+ , ( True
521+ , (== '[')
522+ , (== '[')
523+ , \x -> if x == '[' then ']' else error "Not an opening quote."
524+ , "The[ quick brown] fox"
525+ , ["The[ quick brown]", "fox"])
526+ , ( True
527+ , (== '[')
528+ , (== '[')
529+ , \x -> if x == '[' then ']' else error "Not an opening quote."
530+ , "The[ qui[ck] brown] \\ f[ ox]"
531+ , ["The[ qui[ck] brown]", " f[ ox]"])
532+ , ( False
533+ , (== '[')
534+ , (== '[')
535+ , \x -> if x == '[' then ']' else error "Not an opening quote."
536+ , "The[ qui[ck] brown] fox"
537+ , ["The qui[ck] brown", "fox"])
538+ ]
539+
540+
541+-- splitWithPass :: Property
542+-- splitWithPass =
543+-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
544+-- case S.parse (P.serialWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
545+-- Right (result_first, result_second) -> case ls of
546+-- 0 : 1 : _ -> (result_first == 0) && (result_second == 1)
547+-- _ -> False
548+-- Left _ -> case ls of
549+-- 0 : 1 : _ -> False
550+-- _ -> True
551+
552+-- splitWithFailLeft :: Property
553+-- splitWithFailLeft =
554+-- property (case S.parse (P.serialWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
555+-- Right _ -> False
556+-- Left _ -> True)
557+
558+-- splitWithFailRight :: Property
559+-- splitWithFailRight =
560+-- property (case S.parse (P.serialWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
561+-- Right _ -> False
562+-- Left _ -> True)
563+
564+-- splitWithFailBoth :: Property
565+-- splitWithFailBoth =
566+-- property (case S.parse (P.serialWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
567+-- Right _ -> False
568+-- Left _ -> True)
569+
570+-- teeWithPass :: Property
571+-- teeWithPass =
572+-- forAll (chooseInt (0, 10000)) $ \n ->
573+-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
574+-- let
575+-- prsr = P.take n FL.toList
576+-- in
577+-- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of
578+-- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
579+-- Left _ -> property False
580+
581+-- teeWithFailLeft :: Property
582+-- teeWithFailLeft =
583+-- property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
584+-- Right _ -> False
585+-- Left _ -> True)
586+
587+-- teeWithFailRight :: Property
588+-- teeWithFailRight =
589+-- property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
590+-- Right _ -> False
591+-- Left _ -> True)
592+
593+-- teeWithFailBoth :: Property
594+-- teeWithFailBoth =
595+-- property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
596+-- Right _ -> False
597+-- Left _ -> True)
598+
599+deintercalate :: Property
600+deintercalate =
601+ forAll (listOf (chooseAny :: Gen Int)) $ \ls ->
602+ case S.parse p (S.fromList ls) of
603+ Right evenOdd -> evenOdd == List.partition even ls
604+ Left _ -> False
605+
606+ where
607+ p1 = P.takeWhile even FL.toList
608+ p2 = P.takeWhile odd FL.toList
609+ partition =
610+ FL.tee (fmap concat $ FL.lefts FL.toList)
611+ (fmap concat $ FL.rights FL.toList)
612+ p = P.deintercalate p1 p2 partition
613+
614+-- shortestPass :: Property
615+-- shortestPass =
616+-- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
617+-- let
618+-- prsr_1 = P.takeWhile (<= (mid_value `Prelude.div` 2)) FL.toList
619+-- prsr_2 = P.takeWhile (<= mid_value) FL.toList
620+-- prsr_shortest = P.shortest prsr_1 prsr_2
621+-- in
622+-- case S.parse prsr_shortest (S.fromList ls) of
623+-- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)
624+-- Left _ -> property False
625+
626+-- shortestFailLeft :: Property
627+-- shortestFailLeft =
628+-- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
629+-- Right r -> r == 1
630+-- Left _ -> False)
631+
632+-- shortestFailRight :: Property
633+-- shortestFailRight =
634+-- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
635+-- Right r -> r == 1
636+-- Left _ -> False)
637+
638+-- shortestFailBoth :: Property
639+-- shortestFailBoth =
640+-- property (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
641+-- Right _ -> False
642+-- Left _ -> True)
643+
644+many :: Property
645+many =
646+ forAll (listOf (chooseInt (0, 1))) $ \ls ->
647+ let fldstp conL currL = return $ FL.Partial $ conL ++ currL
648+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return
649+ prsr =
650+ flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
651+ in
652+ case S.parse prsr (S.fromList ls) of
653+ Right res_list -> checkListEqual res_list
654+ $ Prelude.filter (== 0) ls
655+ Left _ -> property False
656+
657+-- many_empty :: Property
658+-- many_empty =
659+-- property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
660+-- Right res_list -> checkListEqual res_list ([] :: [Int])
661+-- Left _ -> property False)
662+
663+some :: Property
664+some =
665+ forAll (listOf (chooseInt (0, 1))) $ \genLs ->
666+ let
667+ ls = 0 : genLs
668+ fldstp conL currL = return $ FL.Partial $ conL ++ currL
669+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return
670+ prsr =
671+ flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
672+ in
673+ case S.parse prsr (S.fromList ls) of
674+ Right res_list -> res_list == Prelude.filter (== 0) ls
675+ Left _ -> False
676+ -}
677+
678+-- someFail :: Property
679+-- someFail =
680+-- property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
681+-- Right _ -> False
682+-- Left _ -> True)
683+
684+-------------------------------------------------------------------------------
685+-- Instances
686+-------------------------------------------------------------------------------
687+
688+parse :: (MonadThrow f, Unbox a) =>
689+ P.ParserChunked a f b -> S.Stream f (A.Array a) -> f b
690+parse parser stream = fmap fst (P.parseBreak parser stream)
691+
692+applicative :: Property
693+applicative =
694+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
695+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
696+ let parser =
697+ (,)
698+ <$> ParserD.fromFold (FL.take (length list1) FL.toList)
699+ <*> ParserD.fromFold (FL.take (length list2) FL.toList)
700+ in monadicIO $ do
701+ let arrays = [A.fromList list1, A.fromList list2]
702+ (olist1, olist2) <-
703+ run $ parse (P.fromRaw parser) (S.fromList arrays)
704+ listEquals (==) olist1 list1
705+ listEquals (==) olist2 list2
706+
707+{-
708+sequence :: Property
709+sequence =
710+ forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
711+ let p xs = ParserD.fromFold (FL.take (length xs) FL.toList)
712+ in monadicIO $ do
713+ outs <- run $
714+ parse
715+ (Prelude.sequence $ fmap p ins)
716+ (S.fromList $ concat ins)
717+ listEquals (==) outs ins
718+ -}
719+
720+monad :: Property
721+monad =
722+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
723+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
724+ let parser = do
725+ olist1 <- ParserD.fromFold (FL.take (length list1) FL.toList)
726+ olist2 <- ParserD.fromFold (FL.take (length list2) FL.toList)
727+ return (olist1, olist2)
728+ in monadicIO $ do
729+ let arrays = [A.fromList list1, A.fromList list2]
730+ (olist1, olist2) <-
731+ run $ parse (P.fromRaw parser) (S.fromList arrays)
732+ listEquals (==) olist1 list1
733+ listEquals (==) olist2 list2
734+
735+{-
736+-------------------------------------------------------------------------------
737+-- Stream parsing
738+-------------------------------------------------------------------------------
739+
740+parseMany :: Property
741+parseMany =
742+ forAll (chooseInt (1,100)) $ \len ->
743+ forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
744+ monadicIO $ do
745+ outs <- do
746+ let p = P.fromFold $ FL.take len FL.toList
747+ run
748+ $ S.fold FL.toList
749+ $ S.parseMany p (S.fromList $ concat ins)
750+ listEquals (==) outs ins
751+
752+-------------------------------------------------------------------------------
753+-- Test for a particular case hit during fs events testing
754+-------------------------------------------------------------------------------
755+
756+evId :: [Word8]
757+evId = [96,238,17,9,0,0,0,0]
758+
759+evFlags :: [Word8]
760+evFlags = [0,4,1,0,0,0,0,0]
761+
762+evPathLen :: [Word8]
763+evPathLen = [71,0,0,0,0,0,0,0]
764+
765+evPath :: [Word8]
766+evPath =
767+ [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
768+ ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
769+ ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
770+ ,114,101,97,109,108,121,47,116,109,112,47,122,122
771+ ]
772+
773+event :: [Word8]
774+event = evId ++ evFlags ++ evPathLen ++ evPath
775+
776+data Event = Event
777+ { eventId :: Word64
778+ , eventFlags :: Word32
779+ , eventAbsPath :: A.Array Word8
780+ } deriving (Show, Ord, Eq)
781+
782+readOneEvent :: P.Parser Word8 IO Event
783+readOneEvent = do
784+ arr <- P.takeEQ 24 (A.writeN 24)
785+ let arr1 = A.castUnsafe arr :: A.Array Word64
786+ eid = A.unsafeIndex 0 arr1
787+ eflags = A.unsafeIndex 1 arr1
788+ pathLen = fromIntegral $ A.unsafeIndex 2 arr1
789+ -- XXX handle if pathLen is 0
790+ path <- P.takeEQ pathLen (A.writeN pathLen)
791+ return $ Event
792+ { eventId = eid
793+ , eventFlags = fromIntegral eflags
794+ , eventAbsPath = path
795+ }
796+
797+parseMany2Events :: Property
798+parseMany2Events =
799+ monadicIO $ do
800+ xs <-
801+ ( run
802+ $ S.fold FL.toList
803+ $ S.parseMany readOneEvent
804+ $ S.fromList (concat (replicate 2 event))
805+ )
806+ assert (length xs == 2)
807+ -- XXX assuming little endian machine
808+ let ev = Event
809+ { eventId = 152170080
810+ , eventFlags = 66560
811+ , eventAbsPath = A.fromList evPath
812+ }
813+ in listEquals (==) xs (replicate 2 ev)
814+
815+manyEqParseMany :: Property
816+manyEqParseMany =
817+ forAll (listOf (chooseInt (0, 100))) $ \lst ->
818+ forAll (chooseInt (1, 100)) $ \i ->
819+ monadicIO $ do
820+ let strm = S.fromList lst
821+ r1 <- run $ S.parse (P.many (split i) FL.toList) strm
822+ r2 <- run $ S.fold FL.toList $ S.parseMany (split i) strm
823+ assert $ r1 == r2
824+
825+ where
826+
827+ split i = P.fromFold (FL.take i FL.toList)
828+
829+
830+takeEndBy1 :: Property
831+takeEndBy1 =
832+ forAll (listOf (chooseInt (0, 1))) $ \ls ->
833+ case S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of
834+ Right parsed_list ->
835+ checkListEqual
836+ parsed_list
837+ (takeWhileAndFirstFail (not . predicate) ls)
838+ Left _ -> property False
839+ where
840+ prsr = P.many (P.satisfy (const True)) FL.toList
841+
842+ predicate = (== 1)
843+
844+ takeWhileAndFirstFail prd (x : xs) =
845+ if prd x
846+ then x : takeWhileAndFirstFail prd xs
847+ else [x]
848+ takeWhileAndFirstFail _ [] = []
849+
850+splitWithSuffix
851+ :: Monad m
852+ => (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b
853+splitWithSuffix predicate f = S.foldMany (FL.takeEndBy predicate f)
854+
855+takeEndBy2 :: Property
856+takeEndBy2 =
857+ forAll (listOf (chooseInt (0, 1))) $ \ls ->
858+ let
859+ strm = S.fromList ls
860+
861+ predicate = (==0)
862+
863+ eitherParsedList =
864+ S.fold FL.toList $
865+ S.parseMany (P.takeEndBy predicate prsr) strm
866+
867+ where
868+
869+ prsr = P.many (P.satisfy (const True)) FL.toList
870+
871+ eitherSplitList =
872+ case ls of
873+ [] -> return []
874+ _ ->
875+ if last ls == 0
876+ then S.fold FL.toList $ S.append strm1 (S.fromList [])
877+ else S.fold FL.toList strm1
878+
879+ where
880+
881+ strm1 = splitWithSuffix predicate FL.toList strm
882+ in
883+ case eitherParsedList of
884+ Left _ -> property False
885+ Right parsedList ->
886+ case eitherSplitList of
887+ Left _ -> property False
888+ Right splitList -> checkListEqual parsedList splitList
889+
890+takeEndByEsc :: Property
891+takeEndByEsc =
892+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
893+ let
894+ msg = "takeEndByEsc: trailing escape"
895+
896+ isSep = even
897+
898+ isEsc x = x `mod` 6 == 0
899+
900+ prsr = P.takeEndByEsc isEsc isSep prsr0
901+
902+ where
903+
904+ prsr0 = P.many (P.satisfy (const True)) FL.toList
905+
906+ escapeSep maybePrevEsc [] =
907+ case maybePrevEsc of
908+ Nothing -> []
909+ Just prevEsc -> [prevEsc]
910+ escapeSep maybePrevEsc (x : xs) =
911+ case maybePrevEsc of
912+ Nothing ->
913+ if isEsc x
914+ then escapeSep (Just x) xs
915+ else
916+ if isSep x
917+ then [x]
918+ else x : escapeSep Nothing xs
919+ Just _ ->
920+ x : escapeSep Nothing xs
921+ in
922+ case S.parse prsr (S.fromList ls) of
923+ Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls
924+ Left err -> property (displayException err == msg)
925+
926+takeFramedByEsc_ :: Property
927+takeFramedByEsc_ =
928+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
929+ let
930+ isBegin = (== 0)
931+
932+ isEnd = (== 1)
933+
934+ isEsc = (== 2)
935+
936+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
937+
938+ checkPass (x : xs) maybePrevEsc openMinusClose =
939+ case maybePrevEsc of
940+ Nothing ->
941+ if isEsc x
942+ then checkPass xs (Just x) openMinusClose
943+ else
944+ if isBegin x
945+ then checkPass xs Nothing (openMinusClose + 1)
946+ else
947+ if isEnd x
948+ then
949+ case openMinusClose of
950+ 0 -> False
951+ 1 -> True
952+ _ ->
953+ checkPass
954+ xs
955+ Nothing
956+ (openMinusClose - 1)
957+ else
958+ checkPass xs Nothing openMinusClose
959+ Just _ -> checkPass xs Nothing openMinusClose
960+ checkPass [] _ _ = False
961+
962+ checkPassBeg [] = False
963+ checkPassBeg xxs@(x:_)
964+ | isBegin x = checkPass xxs Nothing (0 :: Int)
965+ | otherwise = False
966+
967+ escapeFrame begin end escape l =
968+ let
969+ helper (x : xs) maybePrevEsc openMinusClose =
970+ case maybePrevEsc of
971+ Nothing ->
972+ if escape x
973+ then helper xs (Just x) openMinusClose
974+ else
975+ if begin x
976+ then helper xs Nothing (openMinusClose + 1)
977+ else
978+ if end x
979+ then
980+ if openMinusClose - 1 == 0
981+ then []
982+ else
983+ helper
984+ xs
985+ Nothing
986+ (openMinusClose - 1)
987+ else
988+ x : helper xs Nothing openMinusClose
989+ Just prevEsc ->
990+ if escape x || begin x || end x
991+ then x : helper xs Nothing openMinusClose
992+ else
993+ prevEsc : x : helper xs Nothing openMinusClose
994+ helper [] _ _ = error "Cannot Reach Here"
995+ in
996+ helper l Nothing (0 :: Int)
997+ in
998+ case S.parse prsr (S.fromList ls) of
999+ Right parsed_list ->
1000+ if checkPassBeg ls
1001+ then checkListEqual parsed_list $
1002+ escapeFrame isBegin isEnd isEsc ls
1003+ else property False
1004+ Left _ ->
1005+ if checkPassBeg ls
1006+ then property False
1007+ else property True
1008+
1009+takeFramedByEsc_Pass :: Property
1010+takeFramedByEsc_Pass =
1011+ forAll (listOf (chooseInt (min_value, max_value))) $ \list ->
1012+ let
1013+ ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)
1014+
1015+ isBegin = (== 0)
1016+
1017+ isEnd = (== 1)
1018+
1019+ isEsc = (== 2)
1020+
1021+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1022+
1023+ escapeFrame begin end escape l =
1024+ let
1025+ helper (x : xs) maybePrevEsc openMinusClose =
1026+ case maybePrevEsc of
1027+ Nothing ->
1028+ if escape x
1029+ then helper xs (Just x) openMinusClose
1030+ else
1031+ if begin x
1032+ then
1033+ if openMinusClose == 0
1034+ then helper xs Nothing (openMinusClose + 1)
1035+ else x : helper xs Nothing (openMinusClose + 1)
1036+ else
1037+ if end x
1038+ then
1039+ if openMinusClose - 1 == 0
1040+ then []
1041+ else
1042+ x :
1043+ helper
1044+ xs
1045+ Nothing
1046+ (openMinusClose - 1)
1047+ else
1048+ x : helper xs Nothing openMinusClose
1049+ Just _ ->
1050+ x : helper xs Nothing openMinusClose
1051+ helper [] _ _ = error "Cannot Reach Here"
1052+ in
1053+ helper l Nothing (0 :: Int)
1054+ in
1055+ case S.parse prsr (S.fromList ls) of
1056+ Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls
1057+ _ -> property False
1058+
1059+takeFramedByEsc_Fail1 :: Property
1060+takeFramedByEsc_Fail1 =
1061+ let
1062+ msg = "takeFramedByEsc_: missing frame end"
1063+
1064+ isBegin = (== 0)
1065+
1066+ isEnd = (== 0)
1067+
1068+ isEsc = (== 2)
1069+
1070+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1071+
1072+ ls = [0 :: Int]
1073+ in
1074+ case S.parse prsr (S.fromList ls) of
1075+ Right _ -> property False
1076+ Left err -> property (displayException err == msg)
1077+
1078+takeFramedByEsc_Fail2 :: Property
1079+takeFramedByEsc_Fail2 =
1080+ let
1081+ msg = "takeFramedByEsc_: missing frame start"
1082+
1083+ isBegin = (== 0)
1084+
1085+ isEnd = (== 1)
1086+
1087+ isEsc = (== 1)
1088+
1089+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1090+
1091+ ls = [1 :: Int]
1092+ in
1093+ case S.parse prsr (S.fromList ls) of
1094+ Right _ -> property False
1095+ Left err -> property (displayException err == msg)
1096+
1097+takeFramedByEsc_Fail3 :: Property
1098+takeFramedByEsc_Fail3 =
1099+ let
1100+ msg = "takeFramedByEsc_: missing frame end"
1101+
1102+ isBegin = (== 2)
1103+
1104+ isEnd = (== 1)
1105+
1106+ isEsc = (== 2)
1107+
1108+ prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1109+
1110+ ls = [2 :: Int]
1111+ in
1112+ case S.parse prsr (S.fromList ls) of
1113+ Right _ -> property False
1114+ Left err -> property $ (displayException err == msg)
1115+
1116+takeStartBy_ :: Property
1117+takeStartBy_ =
1118+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
1119+ let ls1 = 1:ls
1120+ msg = "takeFramedByGeneric: empty token"
1121+ in
1122+ case S.parse parser (S.fromList ls1) of
1123+ Right parsed_list ->
1124+ if not $ Prelude.null ls1
1125+ then
1126+ let tls = Prelude.takeWhile (not . predicate) (tail ls1)
1127+ in checkListEqual parsed_list $
1128+ if predicate (head ls1)
1129+ then tls
1130+ else Prelude.takeWhile (not . predicate) ls1
1131+ else property $ Prelude.null parsed_list
1132+ Left err -> property (displayException err == msg)
1133+ where
1134+ predicate = odd
1135+ parser = P.takeStartBy_ predicate FL.toList
1136+ -}
1137+-------------------------------------------------------------------------------
1138+-- Main
1139+-------------------------------------------------------------------------------
1140+
1141+moduleName :: String
1142+moduleName = "Data.Parser"
1143+
1144+main :: IO ()
1145+main =
1146+ hspec $
1147+ H.parallel $
1148+ modifyMaxSuccess (const maxTestCount) $ do
1149+ describe moduleName $ do
1150+
1151+ describe "Instances" $ do
1152+ prop "applicative" applicative
1153+ prop "monad" monad
1154+ {-
1155+ prop "sequence" sequence
1156+ describe "Stream parsing" $ do
1157+ prop "parseMany" parseMany
1158+ prop "parseMany2Events" parseMany2Events
1159+
1160+ describe "test for accumulator" $ do
1161+ prop "P.fromFold FL.sum = FL.sum" fromFold
1162+ prop "fromPure value provided" fromPure
1163+ prop "fromPure monadic value provided" fromEffect
1164+ prop "fail err = Left (SomeException (ParseError err))" parserFail
1165+ prop "always fail" die
1166+ prop "always fail but monadic" dieM
1167+
1168+ describe "test for element parser" $ do
1169+ prop "peek = head with list length > 0" peekPass
1170+ prop "peek fail on []" peekFail
1171+ prop "eof pass on []" eofPass
1172+ prop "eof fail on non-empty list" eofFail
1173+ prop "first element exists and >= mid_value" satisfyPass
1174+ prop "one pass on [Int]" onePass
1175+ prop "one fail on []" one
1176+ prop "check first element exists and satisfies predicate" satisfy
1177+
1178+ describe "test for sequence parser" $ do
1179+ prop "P.takeBetween = Prelude.take when len >= m and len <= n"
1180+ takeBetweenPass
1181+ prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"
1182+ ++ "otherwise fail") Main.takeBetween
1183+
1184+ prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
1185+ prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"
1186+ Main.takeEQ
1187+ prop "P.takeGE n ls = ls when len >= n" takeGEPass
1188+ prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
1189+ -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
1190+ -- prop "Fail when stream length exceeded" lookAheadFail
1191+ -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
1192+ prop "P.takeEndBy_ test" Main.takeEndBy_
1193+ prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"
1194+ ++ " tail") takeStartBy
1195+ prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
1196+ prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"
1197+ ++ " else check why failed") takeWhile1
1198+ prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP
1199+ prop ("P.takeP = Prelude.take") takeP
1200+ prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
1201+ prop "many (P.wordBy ' ') = words'" wordBy
1202+ parseManyWordQuotedBy
1203+ -- prop "choice" choice
1204+ -- prop "" splitWithPass
1205+ -- prop "" splitWithFailLeft
1206+ -- prop "" splitWithFailRight
1207+ -- prop "" splitWithFailBoth
1208+ -- prop "" teeWithPass
1209+ -- prop "" teeWithFailLeft
1210+ -- prop "" teeWithFailRight
1211+ -- prop "" teeWithFailBoth
1212+ prop "deintercalate" deintercalate
1213+ -- prop "" shortestPass
1214+ -- prop "" shortestFailLeft
1215+ -- prop "" shortestFailRight
1216+ -- prop "" shortestFailBoth
1217+ prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1218+ ++ "Prelude.filter (== 0)") many
1219+ -- prop "[] due to parser being die" many_empty
1220+ prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1221+ ++ "Prelude.filter (== 0)") some
1222+ -- prop "fail due to parser being die" someFail
1223+ prop "P.many == S.parseMany" manyEqParseMany
1224+
1225+ prop "takeEndBy_" takeEndBy_
1226+ prop "takeEndBy1" takeEndBy1
1227+ prop "takeEndBy2" takeEndBy2
1228+ prop "takeEndByEsc" takeEndByEsc
1229+ prop "takeFramedByEsc_" takeFramedByEsc_
1230+ prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass
1231+ prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1
1232+ prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2
1233+ prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3
1234+ prop "takeStartBy_" takeStartBy_
1235+
1236+ takeProperties
1237+ -}
test/streamly-tests.cabal+7
@@ -285,6 +285,13 @@ test-suite Data.Parser.ParserD
285 if flag(limit-build-mem)
285 if flag(limit-build-mem)
286 ghc-options: +RTS -M1500M -RTS
286 ghc-options: +RTS -M1500M -RTS
287
287
288+test-suite Data.Parser.Chunked
289+ import: test-options
290+ type: exitcode-stdio-1.0
291+ main-is: Streamly/Test/Data/Parser/Chunked.hs
292+ if flag(limit-build-mem)
293+ ghc-options: +RTS -M1500M -RTS
294+
288test-suite Data.SmallArray
295test-suite Data.SmallArray
289 import: test-options
296 import: test-options
290 type: exitcode-stdio-1.0
297 type: exitcode-stdio-1.0