git.iko.soy/streamly
on 01643fe help sign in
streamly/src/Streamly/Internal/Data/Producer/Source.hs
238 lines 7.9 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.Producer.Source
3-- Copyright : (c) 2021 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
8--
9-- A 'Source' is a seed that can be unfolded to a stream with a buffer. Allows
10-- to 'unread' data i.e. push unused data back to the source buffer. This is
11-- useful in parsing applications with backtracking.
12--
14module Streamly.Internal.Data.Producer.Source
15 ( Source
17 -- * Creation
18 , source
20 -- * Transformation
21 , unread
23 -- * Consumption
24 , isEmpty
25 , producer
27 -- * Parsing
28 , parse
29 , parseMany
30 , parseManyD
31 )
32where
34#include "inline.hs"
36import Control.Exception (assert)
37import Control.Monad.Catch (MonadThrow, throwM)
38import GHC.Exts (SpecConstrAnnotation(..))
39import GHC.Types (SPEC(..))
40import Streamly.Internal.Data.Parser.ParserD (ParseError(..), Step(..))
41import Streamly.Internal.Data.Producer.Type (Producer(..))
42import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))
44import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
45import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK
47import Prelude hiding (read)
49-- | A seed with a buffer. It allows us to 'unread' or return some data
50-- after reading it. Useful in backtracked parsing.
51--
52data Source a b = Source [b] (Maybe a)
54-- | Make a source from a seed value. The buffer would start as empty.
55--
56-- /Pre-release/
57source :: Maybe a -> Source a b
58source = Source []
60-- | Return some unused data back to the source. The data is prepended (or
61-- consed) to the source.
62--
63-- /Pre-release/
64unread :: [b] -> Source a b -> Source a b
65unread xs (Source ys seed) = Source (xs ++ ys) seed
67-- | Determine if the source is empty.
68isEmpty :: Source a b -> Bool
69isEmpty (Source [] Nothing) = True
70isEmpty _ = False
72-- | Convert a producer to a producer from a buffered source. Any buffered data
73-- is read first and then the seed is unfolded.
74--
75-- /Pre-release/
76{-# INLINE_NORMAL producer #-}
77producer :: Monad m => Producer m a b -> Producer m (Source a b) b
78producer (Producer step1 inject1 extract1) = Producer step inject extract
80 where
82 inject (Source [] (Just a)) = do
83 s <- inject1 a
84 return $ Left s
85 inject (Source xs a) = return $ Right (xs, a)
87 {-# INLINE_LATE step #-}
88 step (Left s) = do
89 r <- step1 s
90 return $ case r of
91 Yield x s1 -> Yield x (Left s1)
92 Skip s1 -> Skip (Left s1)
93 Stop -> Stop
94 step (Right ([], Nothing)) = return Stop
95 step (Right ([], Just _)) = error "Bug: unreachable"
96 step (Right (x:[], Just a)) = do
97 s <- inject1 a
98 return $ Yield x (Left s)
99 step (Right (x:xs, a)) = return $ Yield x (Right (xs, a))
101 extract (Left s) = Source [] . Just <$> extract1 s
102 extract (Right (xs, a)) = return $ Source xs a
104-------------------------------------------------------------------------------
105-- Parsing
106-------------------------------------------------------------------------------
108-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need
109-- to make a newtype.
110{-# ANN type List NoSpecConstr #-}
111newtype List a = List {getList :: [a]}
113{-# INLINE_NORMAL parseD #-}
114parseD
115 :: MonadThrow m
116 => ParserD.Parser m a b
117 -> Producer m (Source s a) a
118 -> Source s a
119 -> m (b, Source s a)
120parseD
121 (ParserD.Parser pstep initial extract)
122 (Producer ustep uinject uextract)
123 seed = do
125 res <- initial
126 case res of
127 ParserD.IPartial s -> do
128 state <- uinject seed
129 go SPEC state (List []) s
130 ParserD.IDone b -> return (b, seed)
131 ParserD.IError err -> throwM $ ParseError err
133 where
135 -- XXX currently we are using a dumb list based approach for backtracking
136 -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
137 -- That will allow us more efficient random back and forth movement.
138 {-# INLINE go #-}
139 go !_ st buf !pst = do
140 r <- ustep st
141 case r of
142 Yield x s -> do
143 pRes <- pstep pst x
144 case pRes of
145 Partial 0 pst1 -> go SPEC s (List []) pst1
146 Partial n pst1 -> do
147 assert (n <= length (x:getList buf)) (return ())
148 let src0 = Prelude.take n (x:getList buf)
149 src = Prelude.reverse src0
150 gobuf SPEC s (List []) (List src) pst1
151 Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1
152 Continue n pst1 -> do
153 assert (n <= length (x:getList buf)) (return ())
154 let (src0, buf1) = splitAt n (x:getList buf)
155 src = Prelude.reverse src0
156 gobuf SPEC s (List buf1) (List src) pst1
157 Done n b -> do
158 assert (n <= length (x:getList buf)) (return ())
159 let src0 = Prelude.take n (x:getList buf)
160 src = Prelude.reverse src0
161 s1 <- uextract s
162 return (b, unread src s1)
163 Error err -> throwM $ ParseError err
164 Skip s -> go SPEC s buf pst
165 Stop -> do
166 b <- extract pst
167 return (b, unread (reverse $ getList buf) (source Nothing))
169 gobuf !_ s buf (List []) !pst = go SPEC s buf pst
170 gobuf !_ s buf (List (x:xs)) !pst = do
171 pRes <- pstep pst x
172 case pRes of
173 Partial 0 pst1 ->
174 gobuf SPEC s (List []) (List xs) pst1
175 Partial n pst1 -> do
176 assert (n <= length (x:getList buf)) (return ())
177 let src0 = Prelude.take n (x:getList buf)
178 src = Prelude.reverse src0 ++ xs
179 gobuf SPEC s (List []) (List src) pst1
180 Continue 0 pst1 ->
181 gobuf SPEC s (List (x:getList buf)) (List xs) pst1
182 Continue n pst1 -> do
183 assert (n <= length (x:getList buf)) (return ())
184 let (src0, buf1) = splitAt n (x:getList buf)
185 src = Prelude.reverse src0 ++ xs
186 gobuf SPEC s (List buf1) (List src) pst1
187 Done n b -> do
188 assert (n <= length (x:getList buf)) (return ())
189 let src0 = Prelude.take n (x:getList buf)
190 src = Prelude.reverse src0
191 s1 <- uextract s
192 return (b, unread src s1)
193 Error err -> throwM $ ParseError err
195-- | Parse a buffered source using a parser, returning the parsed value and the
196-- remaining source.
197--
198-- /Pre-release/
199{-# INLINE [3] parse #-}
200parse
201 :: MonadThrow m
202 => ParserK.Parser m a b
203 -> Producer m (Source s a) a
204 -> Source s a
205 -> m (b, Source s a)
206parse = parseD . ParserK.fromParserK
208-------------------------------------------------------------------------------
209-- Nested parsing
210-------------------------------------------------------------------------------
212{-# INLINE parseManyD #-}
213parseManyD :: MonadThrow m =>
214 ParserD.Parser m a b
215 -> Producer m (Source x a) a
216 -> Producer m (Source x a) b
217parseManyD parser reader = Producer step return return
219 where
221 {-# INLINE_LATE step #-}
222 step src = do
223 if isEmpty src
224 then return Stop
225 else do
226 (b, s1) <- parseD parser reader src
227 return $ Yield b s1
229-- | Apply a parser repeatedly on a buffered source producer to generate a
230-- producer of parsed values.
231--
232-- /Pre-release/
233{-# INLINE parseMany #-}
234parseMany :: MonadThrow m =>
235 ParserK.Parser m a b
236 -> Producer m (Source x a) a
237 -> Producer m (Source x a) b
238parseMany parser = parseManyD (ParserK.fromParserK parser)