git.iko.soy/streamly
on 9445975 help sign in
streamly/src/Streamly/Internal/Data/Parser.hs
258 lines 6.4 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE RankNTypes #-}
4{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE ScopedTypeVariables #-}
7-- |
8-- Module : Streamly.Internal.Data.Parser
9-- Copyright : (c) 2020 Composewell Technologies
10-- License : BSD3
11-- Maintainer : streamly@composewell.com
12-- Stability : experimental
13-- Portability : GHC
14--
15-- Parsers.
17module Streamly.Internal.Data.Parser
18 (
19 Parser (..)
21 -- * Parsers
22 , any
23 , all
25 , takeWhile
26 , takeExact
27 , takeAtLeast
29 , endOn
30 , endAfter
31 , endBefore
33 , finishBy
34 )
35where
37import Prelude
38 hiding (any, all, takeWhile)
39import Streamly.Internal.Data.Parser.Types (Parser(..), Step(..))
40import Streamly.Internal.Data.Fold.Types (Fold(..))
42import Streamly.Internal.Data.Strict
44-------------------------------------------------------------------------------
45-- Terminating folds
46-------------------------------------------------------------------------------
47--
48-- XXX any/all should be terminating folds when we have a terminating fold
49-- type.
50--
51-- |
52-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
53-- > Right True
54--
55{-# INLINABLE any #-}
56any :: Monad m => (a -> Bool) -> Parser m a Bool
57any predicate = Parser step initial (return . Right)
58 where
59 initial = return False
60 step s a = return $
61 if s
62 then Stop 0 True
63 else
64 if predicate a
65 then Stop 0 True
66 else Yield 0 False
68-- |
69-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
70-- > Right False
71--
72{-# INLINABLE all #-}
73all :: Monad m => (a -> Bool) -> Parser m a Bool
74all predicate = Parser step initial (return . Right)
75 where
76 initial = return True
77 step s a = return $
78 if s
79 then
80 if predicate a
81 then Yield 0 True
82 else Stop 0 False
83 else Stop 0 False
85-------------------------------------------------------------------------------
86-- Taking elements
87-------------------------------------------------------------------------------
88--
89-- | Stops after taking exactly @n@ input elements.
90--
91-- * Stops - after @n@ elements.
92-- * Fails - if the stream ends before it can collect @n@ elements.
93--
94-- >>> S.parse (PR.takeExact 4 FL.toList) $ S.fromList [1,0,1]
95-- > Left "takeExact: Expecting exactly 4 elements, got 3"
96--
97-- /Internal/
98--
99{-# INLINABLE takeExact #-}
100takeExact :: Monad m => Int -> Fold m a b -> Parser m a b
101takeExact n (Fold fstep finitial fextract) = Parser step initial extract
103 where
105 initial = (Tuple' 0) <$> finitial
107 step (Tuple' i r) a = do
108 res <- fstep r a
109 let i1 = i + 1
110 s1 = Tuple' i1 res
111 return $ if i1 < n then Skip 0 s1 else Stop 0 s1
113 extract (Tuple' i r) = fmap f (fextract r)
115 where
117 err =
118 "takeExact: Expecting exactly " ++ show n
119 ++ " elements, got " ++ show i
121 f x =
122 if n == i
123 then Right x
124 else Left err
126-- | Take at least @n@ input elements, but can collect more.
127--
128-- * Stops - never.
129-- * Fails - if the stream end before producing @n@ elements.
130--
131-- >>> S.parse (PR.takeAtLeast 4 FL.toList) $ S.fromList [1,0,1]
132-- > Left "takeAtLeast: Expecting at least 4 elements, got only 3"
133--
134-- >>> S.parse (PR.takeAtLeast 4 FL.toList) $ S.fromList [1,0,1,0,1]
135-- > Right [1,0,1,0,1]
136--
137-- /Internal/
138--
139{-# INLINABLE takeAtLeast #-}
140takeAtLeast :: Monad m => Int -> Fold m a b -> Parser m a b
141takeAtLeast n (Fold fstep finitial fextract) = Parser step initial extract
143 where
145 initial = (Tuple' 0) <$> finitial
147 step (Tuple' i r) a = do
148 res <- fstep r a
149 let i1 = i + 1
150 s1 = Tuple' i1 res
151 if i1 < n
152 then return $ Skip 0 s1
153 else return $ Yield 0 s1
155 extract (Tuple' i r) = fmap f (fextract r)
157 where
159 err =
160 "takeAtLeast: Expecting at least " ++ show n
161 ++ " elements, got only " ++ show i
163 f x =
164 if i >= n
165 then Right x
166 else Left err
168-- | Take until the predicate fails. Does not take the failing element.
169--
170-- * Stops - when the predicate fails.
171-- * Fails - never.
172--
173-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
174-- > Right [0,0]
175--
176-- /Internal/
177--
178{-# INLINABLE takeWhile #-}
179takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
180takeWhile predicate (Fold fstep finitial fextract) =
181 Parser step initial extract
183 where
185 initial = finitial
186 step s a = do
187 if predicate a
188 then Yield 0 <$> fstep s a
189 else return $ Stop 1 s
190 extract s = do
191 b <- fextract s
192 return $ Right b
194-- | Keep taking elements until the predicate succeeds. Drop the succeeding
195-- element.
196--
197-- * Stops - when the predicate succeeds.
198-- * Fails - never.
199--
200-- >>> S.parse (PR.endOn (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
201-- > Right [0,0]
202--
203-- >>> S.toList $ S.parseChunks (PR.endOn (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
204-- > [[0,0],[0],[]]
205--
206-- /Internal/
207--
208{-# INLINABLE endOn #-}
209endOn :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
210endOn predicate (Fold fstep finitial fextract) =
211 Parser step initial extract
213 where
215 initial = finitial
216 step s a = do
217 if not (predicate a)
218 then Yield 0 <$> fstep s a
219 else return $ Stop 0 s
220 extract s = do
221 b <- fextract s
222 return $ Right b
224-- | Keep taking elements until the predicate succeeds. Take the succeeding
225-- element as well.
226--
227-- * Stops - when the predicate succeeds.
228-- * Fails - never.
229--
230-- /Unimplemented/
231--
232{-# INLINABLE endAfter #-}
233endAfter ::
234 -- Monad m =>
235 (a -> Bool) -> Fold m a b -> Parser m a b
236endAfter = undefined
238-- | Keep taking elements until the predicate succeeds. Return the succeeding
239-- element back to the input.
240--
241-- * Stops - when the predicate succeeds.
242-- * Fails - never.
243--
244-- /Unimplemented/
245--
246{-# INLINABLE endBefore #-}
247endBefore ::
248 -- Monad m =>
249 (a -> Bool) -> Fold m a b -> Parser m a b
250endBefore = undefined
252-- | Distribute the input to a parse and a fold until the parse succeeds or
253-- fails. The parse can be used to decide the termination of the fold.
254--
255-- /Unimplemented/
256--
257finishBy :: Parser m a x -> Fold m a y -> Parser m a (x, y)
258finishBy = undefined