on 63c646a help sign in
350 lines 8.8 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5-- |
6-- Module : Streamly.Internal.Data.Parser
7-- Copyright : (c) 2020 Composewell Technologies
8-- License : BSD3
9-- Maintainer : streamly@composewell.com
10-- Stability : experimental
11-- Portability : GHC
12--
13-- Parsers.
15module Streamly.Internal.Data.Parser
16 (
17 Parser (..)
19 -- * Combinators
20 , fromFold
22 -- * Folds
23 , any
24 , all
26 , sepBy
27 , sepByMax
28 , sepWithSuffix
29 , wordBy
31 -- * Parsers
32 , takeWhile
33 , takeEQ
34 , takeGE
36 , sepWithPrefix
37 -- , sepWithInfix
38 , groupBy
40 -- Parallel parsers
41 , teeWith
42 , teeWithFst
43 , teeWithMin
44 )
45where
47import Prelude
48 hiding (any, all, takeWhile)
50import Streamly.Internal.Data.Fold.Types (Fold(..))
51import Streamly.Internal.Data.Parser.Tee (teeWith, teeWithFst, teeWithMin)
52import Streamly.Internal.Data.Parser.Types (Parser(..), Step(..))
54import Streamly.Internal.Data.Strict
56-------------------------------------------------------------------------------
57-- Upgrade folds to parses
58-------------------------------------------------------------------------------
59--
60-- | The resulting parse never terminates and never errors out.
61--
62{-# INLINE fromFold #-}
63fromFold :: Monad m => Fold m a b -> Parser m a b
64fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
66 where
68 step s a = Yield 0 <$> fstep s a
70-------------------------------------------------------------------------------
71-- Terminating but not failing folds
72-------------------------------------------------------------------------------
73--
74-- |
75-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
76-- > Right True
77--
78{-# INLINABLE any #-}
79any :: Monad m => (a -> Bool) -> Parser m a Bool
80any predicate = Parser step initial return
82 where
84 initial = return False
86 step s a = return $
87 if s
88 then Stop 0 True
89 else
90 if predicate a
91 then Stop 0 True
92 else Yield 0 False
94-- |
95-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
96-- > Right False
97--
98{-# INLINABLE all #-}
99all :: Monad m => (a -> Bool) -> Parser m a Bool
100all predicate = Parser step initial return
102 where
104 initial = return True
106 step s a = return $
107 if s
108 then
109 if predicate a
110 then Yield 0 True
111 else Stop 0 False
112 else Stop 0 False
114-------------------------------------------------------------------------------
115-- Taking elements
116-------------------------------------------------------------------------------
117--
118-- XXX can we use a "cmp" operation in a common implementation?
119--
120-- | Stops after taking exactly @n@ input elements.
121--
122-- * Stops - after @n@ elements.
123-- * Fails - if the stream ends before it can collect @n@ elements.
124--
125-- >>> S.parse (PR.takeExact 4 FL.toList) $ S.fromList [1,0,1]
126-- > Left "takeEQ: Expecting exactly 4 elements, got 3"
127--
128-- /Internal/
129--
130{-# INLINE takeEQ #-}
131takeEQ :: Monad m => Int -> Fold m a b -> Parser m a b
132takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
134 where
136 initial = Tuple' 0 <$> finitial
138 step (Tuple' i r) a = do
139 res <- fstep r a
140 let i1 = i + 1
141 s1 = Tuple' i1 res
142 if i1 < n then return (Skip 0 s1) else Stop 0 <$> fextract res
144 extract (Tuple' i r) =
145 if n == i
146 then fextract r
147 else error err
149 where
151 err =
152 "takeEQ: Expecting exactly " ++ show n
153 ++ " elements, got " ++ show i
155-- | Take at least @n@ input elements, but can collect more.
156--
157-- * Stops - never.
158-- * Fails - if the stream end before producing @n@ elements.
159--
160-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1]
161-- > Left "takeGE: Expecting at least 4 elements, got only 3"
162--
163-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1,0,1]
164-- > Right [1,0,1,0,1]
165--
166-- /Internal/
167--
168{-# INLINE takeGE #-}
169takeGE :: Monad m => Int -> Fold m a b -> Parser m a b
170takeGE n (Fold fstep finitial fextract) = Parser step initial extract
172 where
174 initial = Tuple' 0 <$> finitial
176 step (Tuple' i r) a = do
177 res <- fstep r a
178 let i1 = i + 1
179 s1 = Tuple' i1 res
180 return $
181 if i1 < n
182 then Skip 0 s1
183 else Yield 0 s1
185 extract (Tuple' i r) = fmap f (fextract r)
187 where
189 err =
190 "takeGE: Expecting at least " ++ show n
191 ++ " elements, got only " ++ show i
193 f x =
194 if i >= n
195 then x
196 else error err
198-- | Take until the predicate fails. The element on which the predicate fails
199-- is returned back to the input stream.
200--
201-- * Stops - when the predicate fails.
202-- * Fails - never.
203--
204-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
205-- > Right [0,0]
206--
207-- @
208-- breakOn p = takeWhile (not p)
209-- @
210--
211-- /Internal/
212--
213{-# INLINE takeWhile #-}
214takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
215takeWhile predicate (Fold fstep finitial fextract) =
216 Parser step initial fextract
218 where
220 initial = finitial
222 step s a =
223 if predicate a
224 then Yield 0 <$> fstep s a
225 else Stop 1 <$> fextract s
227-- | Keep taking elements until the predicate succeeds. Drop the succeeding
228-- element.
229--
230-- * Stops - when the predicate succeeds.
231-- * Fails - never.
232--
233-- >>> S.parse (PR.sepBy (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
234-- > Right [0,0]
235--
236-- >>> S.toList $ S.splitParse (PR.sepBy (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
237-- > [[0,0],[0],[]]
238--
239-- S.splitOn pred f = S.splitParse (PR.sepBy pred f)
240--
241-- /Internal/
242--
243{-# INLINABLE sepBy #-}
244sepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
245sepBy predicate (Fold fstep finitial fextract) =
246 Parser step initial fextract
248 where
250 initial = finitial
251 step s a =
252 if not (predicate a)
253 then Yield 0 <$> fstep s a
254 else Stop 0 <$> fextract s
256-- | Keep taking elements until the predicate succeeds. Take the succeeding
257-- element as well.
258--
259-- * Stops - when the predicate succeeds.
260-- * Fails - never.
261--
262-- S.splitWithSuffix pred f = S.splitParse (PR.sepWithSuffix pred f)
263--
264-- /Unimplemented/
265--
266{-# INLINABLE sepWithSuffix #-}
267sepWithSuffix ::
268 -- Monad m =>
269 (a -> Bool) -> Fold m a b -> Parser m a b
270sepWithSuffix = undefined
272-- | Keep taking elements until the predicate succeeds. Return the succeeding
273-- element back to the input.
274--
275-- * Stops - when the predicate succeeds.
276-- * Fails - never.
277--
278-- S.splitWithPrefix pred f = S.splitParse (PR.sepWithPrefix pred f)
279--
280-- /Unimplemented/
281--
282{-# INLINABLE sepWithPrefix #-}
283sepWithPrefix ::
284 -- Monad m =>
285 (a -> Bool) -> Fold m a b -> Parser m a b
286sepWithPrefix = undefined
288-- | Split using a condition or a count whichever occurs first. This is a
289-- hybrid of 'splitOn' and 'take'. The element on which the condition succeeds
290-- is dropped.
291--
292-- /Internal/
293--
294{-# INLINABLE sepByMax #-}
295sepByMax :: Monad m
296 => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
297sepByMax predicate count (Fold fstep finitial fextract) =
298 Parser step initial extract
300 where
302 initial = Tuple' 0 <$> finitial
303 step (Tuple' i r) a = do
304 res <- fstep r a
305 let i1 = i + 1
306 s1 = Tuple' i1 res
307 if not (predicate a) && i1 < count
308 then return $ Yield 0 s1
309 else do
310 b <- fextract res
311 return $ Stop 0 b
312 extract (Tuple' _ r) = fextract r
314-- | Like 'splitOn' after stripping leading, trailing, and repeated separators.
315-- Therefore, @".a..b."@ with '.' as the separator would be parsed as
316-- @["a","b"]@. In other words, its like parsing words from whitespace
317-- separated text.
318--
319-- * Stops - when it finds a word separator after a non-word element
320-- * Fails - never.
321--
322-- S.wordsBy pred f = S.splitParse (PR.wordBy pred f)
323--
324-- /Unimplemented/
325--
326{-# INLINABLE wordBy #-}
327wordBy ::
328 -- Monad m =>
329 (a -> Bool) -> Fold m a b -> Parser m a b
330wordBy = undefined
332-- | @group cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the
333-- first group, if @a \`cmp` b@ is 'True' then @b@ is also assigned to the same
334-- group. If @a \`cmp` c@ is 'True' then @c@ is also assigned to the same
335-- group and so on. When the comparison fails a new group is started. Each
336-- group is folded using the fold @f@ and the result of the fold is emitted in
337-- the output stream.
338--
339-- * Stops - when the group ends.
340-- * Fails - never.
341--
342-- S.groupsBy cmp f = S.splitParse (PR.groupBy cmp f)
343--
344-- /Unimplemented/
345--
346{-# INLINABLE groupBy #-}
347groupBy ::
348 -- Monad m =>
349 (a -> a -> Bool) -> Fold m a b -> Parser m a b
350groupBy = undefined