git.iko.soy/streamly
on cc8cd01 help sign in
streamly/src/Streamly/Internal/Data/Parse.hs
254 lines 6.3 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE RankNTypes #-}
4{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE ScopedTypeVariables #-}
7-- |
8-- Module : Streamly.Internal.Data.Parse
9-- Copyright : (c) 2019 Composewell Technologies
10-- License : BSD3
11-- Maintainer : streamly@composewell.com
12-- Stability : experimental
13-- Portability : GHC
14--
15-- Parsers.
17module Streamly.Internal.Data.Parse
18 (
19 Parse (..)
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.Parse.Types (Parse(..), 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-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
52-- > Right True
53--
54{-# INLINABLE any #-}
55any :: Monad m => (a -> Bool) -> Parse m a Bool
56any predicate = Parse step initial (return . Right)
57 where
58 initial = return False
59 step s a = return $
60 if s
61 then Halt 0 True
62 else
63 if predicate a
64 then Halt 0 True
65 else Keep 0 False
67-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
68-- > Right False
69--
70{-# INLINABLE all #-}
71all :: Monad m => (a -> Bool) -> Parse m a Bool
72all predicate = Parse step initial (return . Right)
73 where
74 initial = return True
75 step s a = return $
76 if s
77 then
78 if predicate a
79 then Keep 0 True
80 else Halt 0 False
81 else Halt 0 False
83-------------------------------------------------------------------------------
84-- Taking elements
85-------------------------------------------------------------------------------
86--
87-- | Stops after taking exactly @n@ input elements.
88--
89-- * Stops - after @n@ elements.
90-- * Fails - if the stream ends before it can collect @n@ elements.
91--
92-- >>> S.parse (PR.takeExact 4 FL.toList) $ S.fromList [1,0,1]
93-- > Left "takeExact: Expecting exactly 4 elements, got 3"
94--
95-- /Internal/
96--
97{-# INLINABLE takeExact #-}
98takeExact :: Monad m => Int -> Fold m a b -> Parse m a b
99takeExact n (Fold fstep finitial fextract) = Parse step initial extract
101 where
103 initial = (Tuple' 0) <$> finitial
105 step (Tuple' i r) a = do
106 res <- fstep r a
107 let i1 = i + 1
108 s1 = Tuple' i1 res
109 return $ if i1 < n then Back 0 s1 else Halt 0 s1
111 extract (Tuple' i r) = fmap f (fextract r)
113 where
115 err =
116 "takeExact: Expecting exactly " ++ show n
117 ++ " elements, got " ++ show i
119 f x =
120 if n == i
121 then Right x
122 else Left err
124-- | Take at least @n@ input elements, but can collect more.
125--
126-- * Stops - never.
127-- * Fails - if the stream end before producing @n@ elements.
128--
129-- >>> S.parse (PR.takeAtLeast 4 FL.toList) $ S.fromList [1,0,1]
130-- > Left "takeAtLeast: Expecting at least 4 elements, got only 3"
131--
132-- >>> S.parse (PR.takeAtLeast 4 FL.toList) $ S.fromList [1,0,1,0,1]
133-- > Right [1,0,1,0,1]
134--
135-- /Internal/
136--
137{-# INLINABLE takeAtLeast #-}
138takeAtLeast :: Monad m => Int -> Fold m a b -> Parse m a b
139takeAtLeast n (Fold fstep finitial fextract) = Parse step initial extract
141 where
143 initial = (Tuple' 0) <$> finitial
145 step (Tuple' i r) a = do
146 res <- fstep r a
147 let i1 = i + 1
148 s1 = Tuple' i1 res
149 return $ Back 0 s1
151 extract (Tuple' i r) = fmap f (fextract r)
153 where
155 err =
156 "takeAtLeast: Expecting at least " ++ show n
157 ++ " elements, got only " ++ show i
159 f x =
160 if i >= n
161 then Right x
162 else Left err
164-- | Take until the predicate fails. Does not take the failing element.
165--
166-- * Stops - when the predicate fails.
167-- * Fails - never.
168--
169-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
170-- > Right [0,0]
171--
172-- /Internal/
173--
174{-# INLINABLE takeWhile #-}
175takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parse m a b
176takeWhile predicate (Fold fstep finitial fextract) =
177 Parse step initial extract
179 where
181 initial = finitial
182 step s a = do
183 if predicate a
184 then Keep 0 <$> fstep s a
185 else return $ Halt 1 s
186 extract s = do
187 b <- fextract s
188 return $ Right b
190-- | Keep taking elements until the predicate succeeds. Drop the succeeding
191-- element.
192--
193-- * Stops - when the predicate succeeds.
194-- * Fails - never.
195--
196-- >>> S.parse (PR.endOn (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
197-- > Right [0,0]
198--
199-- >>> S.toList $ S.parseChunks (PR.endOn (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
200-- > [[0,0],[0],[]]
201--
202-- /Internal/
203--
204{-# INLINABLE endOn #-}
205endOn :: Monad m => (a -> Bool) -> Fold m a b -> Parse m a b
206endOn predicate (Fold fstep finitial fextract) =
207 Parse step initial extract
209 where
211 initial = finitial
212 step s a = do
213 if not (predicate a)
214 then Keep 0 <$> fstep s a
215 else return $ Halt 0 s
216 extract s = do
217 b <- fextract s
218 return $ Right b
220-- | Keep taking elements until the predicate succeeds. Take the succeeding
221-- element as well.
222--
223-- * Stops - when the predicate succeeds.
224-- * Fails - never.
225--
226-- /Unimplemented/
227--
228{-# INLINABLE endAfter #-}
229endAfter ::
230 -- Monad m =>
231 (a -> Bool) -> Fold m a b -> Parse m a b
232endAfter = undefined
234-- | Keep taking elements until the predicate succeeds. Return the succeeding
235-- element back to the input.
236--
237-- * Stops - when the predicate succeeds.
238-- * Fails - never.
239--
240-- /Unimplemented/
241--
242{-# INLINABLE endBefore #-}
243endBefore ::
244 -- Monad m =>
245 (a -> Bool) -> Fold m a b -> Parse m a b
246endBefore = undefined
248-- | Distribute the input to a parse and a fold until the parse succeeds or
249-- fails. The parse can be used to decide the termination of the fold.
250--
251-- /Unimplemented/
252--
253finishBy :: Parse m a x -> Fold m a y -> Parse m a (x, y)
254finishBy = undefined