]>
Commit | Line | Data |
---|---|---|
91727d11 | 1 | {-# LANGUAGE RankNTypes, TypeFamilies #-} |
2 | ||
13a43263 | 3 | {-| This module provides @pipes@ utilities for \"text streams\", which are |
4 | streams of strict 'Text' chunks. Use text streams to interact | |
91727d11 | 5 | with both 'IO.Handle's and lazy 'Text's. |
6 | ||
7 | To stream to or from 'IO.Handle's, use 'fromHandle' or 'toHandle'. For | |
8 | example, the following program copies data from one file to another: | |
9 | ||
10 | > import Pipes | |
13a43263 | 11 | > import qualified Data.Text.Pipes as P |
91727d11 | 12 | > import System.IO |
13 | > | |
14 | > main = | |
15 | > withFile "inFile.txt" ReadMode $ \hIn -> | |
16 | > withFile "outFile.txt" WriteMode $ \hOut -> | |
17 | > runEffect $ P.fromHandle hIn >-> P.toHandle hOut | |
18 | ||
13a43263 | 19 | The following is the more Prelude-like and uses Pipes.Safe: |
20 | ||
21 | > import Pipes | |
22 | > import qualified Data.Text.Pipes as P | |
23 | > import Pipes.Safe | |
24 | > | |
25 | > main = runSafeT $ runEffect $ P.readFile "inFile.txt" >-> P.writeFile "outFile.txt" | |
26 | ||
27 | ||
91727d11 | 28 | You can stream to and from 'stdin' and 'stdout' using the predefined 'stdin' |
29 | and 'stdout' proxies, like in the following \"echo\" program: | |
30 | ||
31 | > main = runEffect $ P.stdin >-> P.stdout | |
32 | ||
33 | You can also translate pure lazy 'TL.Text's to and from proxies: | |
34 | ||
35 | > import qualified Data.Text.Lazy as TL | |
36 | > | |
37 | > main = runEffect $ P.fromLazy (TL.pack "Hello, world!\n") >-> P.stdout | |
38 | ||
39 | In addition, this module provides many functions equivalent to lazy | |
40 | 'Text' functions so that you can transform or fold byte streams. For | |
41 | example, to stream only the first three lines of 'stdin' to 'stdout' you | |
42 | would write: | |
43 | ||
44 | > import Pipes | |
45 | > import qualified Pipes.Text as PT | |
46 | > import qualified Pipes.Parse as PP | |
47 | > | |
48 | > main = runEffect $ takeLines 3 PB.stdin >-> PT.stdout | |
49 | > where | |
50 | > takeLines n = PB.unlines . PP.takeFree n . PT.lines | |
51 | ||
52 | The above program will never bring more than one chunk (~ 32 KB) into | |
53 | memory, no matter how long the lines are. | |
54 | ||
55 | Note that functions in this library are designed to operate on streams that | |
56 | are insensitive to chunk boundaries. This means that they may freely split | |
57 | chunks into smaller chunks and /discard empty chunks/. However, they will | |
58 | /never concatenate chunks/ in order to provide strict upper bounds on memory | |
59 | usage. | |
60 | -} | |
61 | ||
62 | module Data.Text.Pipes ( | |
63 | -- * Producers | |
64 | fromLazy, | |
65 | stdin, | |
66 | fromHandle, | |
67 | readFile, | |
68 | stdinLn, | |
69 | -- hGetSome, | |
70 | -- hGet, | |
71 | ||
72 | -- * Servers | |
73 | -- hGetSomeN, | |
74 | -- hGetN, | |
75 | ||
76 | -- * Consumers | |
77 | stdout, | |
78 | stdoutLn, | |
79 | toHandle, | |
80 | writeFile, | |
81 | ||
82 | -- * Pipes | |
83 | map, | |
84 | concatMap, | |
85 | take, | |
86 | drop, | |
87 | takeWhile, | |
88 | dropWhile, | |
89 | filter, | |
90 | -- elemIndices, | |
91 | -- findIndices, | |
92 | scan, | |
93 | ||
94 | -- * Folds | |
95 | toLazy, | |
96 | toLazyM, | |
97 | fold, | |
98 | head, | |
99 | last, | |
100 | null, | |
101 | length, | |
102 | any, | |
103 | all, | |
104 | maximum, | |
105 | minimum, | |
106 | -- elem, | |
107 | -- notElem, | |
108 | find, | |
109 | index, | |
110 | -- elemIndex, | |
111 | -- findIndex, | |
112 | -- count, | |
113 | ||
114 | -- * Splitters | |
115 | splitAt, | |
116 | chunksOf, | |
117 | span, | |
118 | break, | |
119 | splitWith, | |
120 | split, | |
121 | groupBy, | |
122 | group, | |
123 | lines, | |
124 | words, | |
125 | ||
126 | -- * Transformations | |
127 | intersperse, | |
128 | ||
129 | -- * Joiners | |
130 | intercalate, | |
131 | unlines, | |
132 | unwords, | |
133 | ||
134 | -- * Low-level Parsers | |
135 | -- $parse | |
136 | nextByte, | |
137 | drawByte, | |
138 | unDrawByte, | |
139 | peekByte, | |
140 | isEndOfBytes, | |
141 | -- takeWhile', | |
142 | ||
143 | -- * Re-exports | |
144 | -- $reexports | |
145 | module Data.Text, | |
146 | -- module Data.Word, | |
147 | module Pipes.Parse | |
148 | ) where | |
149 | ||
150 | import Control.Exception (throwIO, try) | |
151 | import Control.Monad (liftM, unless) | |
152 | import Control.Monad.Trans.State.Strict (StateT) | |
153 | import qualified Data.Text as T | |
154 | import qualified Data.Text.IO as T | |
155 | import Data.Text (Text) | |
156 | import qualified Data.Text.Lazy as TL | |
157 | import qualified Data.Text.Lazy.IO as TL | |
158 | import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize) | |
159 | import Data.ByteString.Unsafe (unsafeTake, unsafeDrop) | |
160 | import Data.Char (ord) | |
161 | import Data.Functor.Identity (Identity) | |
162 | import qualified Data.List as List | |
163 | import Foreign.C.Error (Errno(Errno), ePIPE) | |
164 | import qualified GHC.IO.Exception as G | |
165 | import Pipes | |
166 | import qualified Pipes.ByteString.Parse as PBP | |
167 | import Pipes.ByteString.Parse ( | |
168 | nextByte, drawByte, unDrawByte, peekByte, isEndOfBytes ) | |
169 | import Pipes.Core (respond, Server') | |
170 | import qualified Pipes.Parse as PP | |
171 | import Pipes.Parse (input, concat, FreeT) | |
172 | import qualified Pipes.Safe.Prelude as Safe | |
173 | import qualified Pipes.Safe as Safe | |
174 | import Pipes.Safe (MonadSafe(..), Base(..)) | |
175 | import qualified Pipes.Prelude as P | |
176 | import qualified System.IO as IO | |
177 | import Data.Char (isSpace) | |
178 | import Prelude hiding ( | |
179 | all, | |
180 | any, | |
181 | break, | |
182 | concat, | |
183 | concatMap, | |
184 | drop, | |
185 | dropWhile, | |
186 | elem, | |
187 | filter, | |
188 | head, | |
189 | last, | |
190 | lines, | |
191 | length, | |
192 | map, | |
193 | maximum, | |
194 | minimum, | |
195 | notElem, | |
196 | null, | |
197 | readFile, | |
198 | span, | |
199 | splitAt, | |
200 | take, | |
201 | takeWhile, | |
202 | unlines, | |
203 | unwords, | |
204 | words, | |
205 | writeFile ) | |
206 | ||
207 | -- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's | |
208 | fromLazy :: (Monad m) => TL.Text -> Producer' Text m () | |
209 | fromLazy = foldrChunks (\e a -> yield e >> a) (return ()) | |
210 | {-# INLINABLE fromLazy #-} | |
211 | ||
212 | -- | Stream bytes from 'stdin' | |
213 | stdin :: MonadIO m => Producer' Text m () | |
214 | stdin = fromHandle IO.stdin | |
215 | {-# INLINABLE stdin #-} | |
216 | ||
6f6f9974 | 217 | -- | Convert a 'IO.Handle' into a text stream using a chunk size |
218 | -- determined by the good sense of the text library. | |
91727d11 | 219 | fromHandle :: MonadIO m => IO.Handle -> Producer' Text m () |
220 | fromHandle h = go where | |
221 | go = do txt <- liftIO (T.hGetChunk h) | |
222 | unless (T.null txt) $ do yield txt | |
223 | go | |
224 | {-# INLINABLE fromHandle#-} | |
225 | ||
6f6f9974 | 226 | {-| Stream text from a file using Pipes.Safe |
227 | ||
228 | >>> runSafeT $ runEffect $ readFile "README.md" >-> map toUpper >-> hoist lift stdout | |
229 | TEXT-PIPES | |
230 | ========== | |
231 | TEXT PIPES, SOMEHOW TO BE FUSED WITH `PIPES-TEXT`. | |
232 | ... | |
233 | >>> | |
234 | -} | |
235 | ||
91727d11 | 236 | readFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Producer' Text m () |
237 | readFile file = Safe.withFile file IO.ReadMode fromHandle | |
238 | {-# INLINABLE readFile #-} | |
239 | ||
240 | stdinLn :: MonadIO m => Producer' Text m () | |
241 | stdinLn = go | |
242 | where | |
243 | go = do | |
244 | eof <- liftIO (IO.hIsEOF IO.stdin) | |
245 | unless eof $ do | |
246 | txt <- liftIO (T.hGetLine IO.stdin) | |
247 | yield txt | |
248 | go | |
249 | ||
250 | {-| Convert a handle into a byte stream using a fixed chunk size | |
251 | ||
252 | 'hGet' waits until exactly the requested number of bytes are available for | |
253 | each chunk. | |
254 | -} | |
255 | -- hGet :: MonadIO m => Int -> IO.Handle -> Producer' Text m () | |
256 | -- hGet size h = go where | |
257 | -- go = do | |
258 | -- eof <- liftIO (IO.hIsEOF h) | |
259 | -- if eof | |
260 | -- then return () | |
261 | -- else do | |
262 | -- bs <- liftIO (T.hGet h size) | |
263 | -- yield bs | |
264 | -- go | |
265 | -- {-# INLINABLE hGet #-} | |
266 | ||
267 | {-| Like 'hGetSome', except you can vary the maximum chunk size for each request | |
268 | -} | |
269 | -- hGetSomeN :: MonadIO m => IO.Handle -> Int -> Server' Int Text m () | |
270 | -- hGetSomeN h = go where | |
271 | -- go size = do | |
272 | -- eof <- liftIO (IO.hIsEOF h) | |
273 | -- if eof | |
274 | -- then return () | |
275 | -- else do | |
276 | -- bs <- liftIO (T.hGetSome h size) | |
277 | -- size2 <- respond bs | |
278 | -- go size2 | |
279 | -- {-# INLINABLE hGetSomeN #-} | |
280 | -- | |
281 | -- -- | Like 'hGet', except you can vary the chunk size for each request | |
282 | -- hGetN :: MonadIO m => IO.Handle -> Int -> Server' Int Text m () | |
283 | -- hGetN h = go where | |
284 | -- go size = do | |
285 | -- eof <- liftIO (IO.hIsEOF h) | |
286 | -- if eof | |
287 | -- then return () | |
288 | -- else do | |
289 | -- bs <- liftIO (T.hGet h size) | |
290 | -- size2 <- respond bs | |
291 | -- go size2 | |
292 | -- {-# INLINABLE hGetN #-} | |
293 | ||
294 | {-| Stream bytes to 'stdout' | |
295 | ||
296 | Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe. | |
297 | ||
298 | Note: For best performance, use @(for source (liftIO . putStr))@ instead of | |
299 | @(source >-> stdout)@. | |
300 | -} | |
301 | stdout :: MonadIO m => Consumer' Text m () | |
302 | stdout = go | |
303 | where | |
304 | go = do | |
305 | txt <- await | |
306 | x <- liftIO $ try (T.putStr txt) | |
307 | case x of | |
308 | Left (G.IOError { G.ioe_type = G.ResourceVanished | |
309 | , G.ioe_errno = Just ioe }) | |
310 | | Errno ioe == ePIPE | |
311 | -> return () | |
312 | Left e -> liftIO (throwIO e) | |
313 | Right () -> go | |
314 | {-# INLINABLE stdout #-} | |
315 | ||
316 | stdoutLn :: (MonadIO m) => Consumer' Text m () | |
317 | stdoutLn = go | |
318 | where | |
319 | go = do | |
320 | str <- await | |
321 | x <- liftIO $ try (T.putStrLn str) | |
322 | case x of | |
323 | Left (G.IOError { G.ioe_type = G.ResourceVanished | |
324 | , G.ioe_errno = Just ioe }) | |
325 | | Errno ioe == ePIPE | |
326 | -> return () | |
327 | Left e -> liftIO (throwIO e) | |
328 | Right () -> go | |
329 | {-# INLINABLE stdoutLn #-} | |
330 | ||
331 | {-| Convert a byte stream into a 'Handle' | |
332 | ||
333 | Note: For best performance, use @(for source (liftIO . hPutStr handle))@ | |
334 | instead of @(source >-> toHandle handle)@. | |
335 | -} | |
336 | toHandle :: MonadIO m => IO.Handle -> Consumer' Text m r | |
337 | toHandle h = for cat (liftIO . T.hPutStr h) | |
338 | {-# INLINABLE toHandle #-} | |
339 | ||
340 | writeFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Consumer' Text m () | |
341 | writeFile file = Safe.withFile file IO.WriteMode toHandle | |
342 | ||
343 | -- | Apply a transformation to each 'Char' in the stream | |
344 | map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r | |
345 | map f = P.map (T.map f) | |
346 | {-# INLINABLE map #-} | |
347 | ||
348 | -- | Map a function over the byte stream and concatenate the results | |
349 | concatMap | |
350 | :: (Monad m) => (Char -> Text) -> Pipe Text Text m r | |
351 | concatMap f = P.map (T.concatMap f) | |
352 | {-# INLINABLE concatMap #-} | |
353 | ||
354 | -- | @(take n)@ only allows @n@ bytes to pass | |
355 | take :: (Monad m, Integral a) => a -> Pipe Text Text m () | |
356 | take n0 = go n0 where | |
357 | go n | |
358 | | n <= 0 = return () | |
359 | | otherwise = do | |
360 | bs <- await | |
361 | let len = fromIntegral (T.length bs) | |
362 | if (len > n) | |
363 | then yield (T.take (fromIntegral n) bs) | |
364 | else do | |
365 | yield bs | |
366 | go (n - len) | |
367 | {-# INLINABLE take #-} | |
368 | ||
369 | -- | @(dropD n)@ drops the first @n@ bytes | |
370 | drop :: (Monad m, Integral a) => a -> Pipe Text Text m r | |
371 | drop n0 = go n0 where | |
372 | go n | |
373 | | n <= 0 = cat | |
374 | | otherwise = do | |
375 | bs <- await | |
376 | let len = fromIntegral (T.length bs) | |
377 | if (len >= n) | |
378 | then do | |
379 | yield (T.drop (fromIntegral n) bs) | |
380 | cat | |
381 | else go (n - len) | |
382 | {-# INLINABLE drop #-} | |
383 | ||
384 | -- | Take bytes until they fail the predicate | |
385 | takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m () | |
386 | takeWhile predicate = go | |
387 | where | |
388 | go = do | |
389 | bs <- await | |
390 | let (prefix, suffix) = T.span predicate bs | |
391 | if (T.null suffix) | |
392 | then do | |
393 | yield bs | |
394 | go | |
395 | else yield prefix | |
396 | {-# INLINABLE takeWhile #-} | |
397 | ||
398 | -- | Drop bytes until they fail the predicate | |
399 | dropWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r | |
400 | dropWhile predicate = go where | |
401 | go = do | |
402 | bs <- await | |
403 | case T.findIndex (not . predicate) bs of | |
404 | Nothing -> go | |
405 | Just i -> do | |
406 | yield (T.drop i bs) | |
407 | cat | |
408 | {-# INLINABLE dropWhile #-} | |
409 | ||
410 | -- | Only allows 'Char's to pass if they satisfy the predicate | |
411 | filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r | |
412 | filter predicate = P.map (T.filter predicate) | |
413 | {-# INLINABLE filter #-} | |
414 | ||
415 | -- | Stream all indices whose elements match the given 'Char' | |
416 | -- elemIndices :: (Monad m, Num n) => Char -> Pipe Text n m r | |
417 | -- elemIndices w8 = findIndices (w8 ==) | |
418 | -- {-# INLINABLE elemIndices #-} | |
419 | ||
420 | -- | Stream all indices whose elements satisfy the given predicate | |
421 | -- findIndices :: (Monad m, Num n) => (Char -> Bool) -> Pipe Text n m r | |
422 | -- findIndices predicate = go 0 | |
423 | -- where | |
424 | -- go n = do | |
425 | -- bs <- await | |
426 | -- each $ List.map (\i -> n + fromIntegral i) (T.findIndices predicate bs) | |
427 | -- go $! n + fromIntegral (T.length bs) | |
428 | -- {-# INLINABLE findIndices #-} | |
429 | ||
430 | -- | Strict left scan over the bytes | |
431 | scan | |
432 | :: (Monad m) | |
433 | => (Char -> Char -> Char) -> Char -> Pipe Text Text m r | |
434 | scan step begin = go begin | |
435 | where | |
436 | go w8 = do | |
437 | bs <- await | |
438 | let bs' = T.scanl step w8 bs | |
439 | w8' = T.last bs' | |
440 | yield bs' | |
441 | go w8' | |
442 | {-# INLINABLE scan #-} | |
443 | ||
444 | {-| Fold a pure 'Producer' of strict 'Text's into a lazy | |
445 | 'TL.Text' | |
446 | -} | |
447 | toLazy :: Producer Text Identity () -> TL.Text | |
448 | toLazy = TL.fromChunks . P.toList | |
449 | {-# INLINABLE toLazy #-} | |
450 | ||
451 | {-| Fold an effectful 'Producer' of strict 'Text's into a lazy | |
452 | 'TL.Text' | |
453 | ||
454 | Note: 'toLazyM' is not an idiomatic use of @pipes@, but I provide it for | |
455 | simple testing purposes. Idiomatic @pipes@ style consumes the chunks | |
456 | immediately as they are generated instead of loading them all into memory. | |
457 | -} | |
458 | toLazyM :: (Monad m) => Producer Text m () -> m TL.Text | |
459 | toLazyM = liftM TL.fromChunks . P.toListM | |
460 | {-# INLINABLE toLazyM #-} | |
461 | ||
462 | -- | Reduce the stream of bytes using a strict left fold | |
463 | fold | |
464 | :: Monad m | |
465 | => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r | |
466 | fold step begin done = P.fold (\x bs -> T.foldl' step x bs) begin done | |
467 | {-# INLINABLE fold #-} | |
468 | ||
469 | -- | Retrieve the first 'Char' | |
470 | head :: (Monad m) => Producer Text m () -> m (Maybe Char) | |
471 | head = go | |
472 | where | |
473 | go p = do | |
474 | x <- nextChar p | |
475 | case x of | |
476 | Left _ -> return Nothing | |
477 | Right (w8, _) -> return (Just w8) | |
478 | {-# INLINABLE head #-} | |
479 | ||
480 | -- | Retrieve the last 'Char' | |
481 | last :: (Monad m) => Producer Text m () -> m (Maybe Char) | |
482 | last = go Nothing | |
483 | where | |
484 | go r p = do | |
485 | x <- next p | |
486 | case x of | |
487 | Left () -> return r | |
488 | Right (bs, p') -> | |
489 | if (T.null bs) | |
490 | then go r p' | |
491 | else go (Just $ T.last bs) p' | |
492 | -- TODO: Change this to 'unsafeLast' when bytestring-0.10.2.0 | |
493 | -- becomes more widespread | |
494 | {-# INLINABLE last #-} | |
495 | ||
496 | -- | Determine if the stream is empty | |
497 | null :: (Monad m) => Producer Text m () -> m Bool | |
498 | null = P.all T.null | |
499 | {-# INLINABLE null #-} | |
500 | ||
501 | -- | Count the number of bytes | |
502 | length :: (Monad m, Num n) => Producer Text m () -> m n | |
503 | length = P.fold (\n bs -> n + fromIntegral (T.length bs)) 0 id | |
504 | {-# INLINABLE length #-} | |
505 | ||
506 | -- | Fold that returns whether 'M.Any' received 'Char's satisfy the predicate | |
507 | any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool | |
508 | any predicate = P.any (T.any predicate) | |
509 | {-# INLINABLE any #-} | |
510 | ||
511 | -- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate | |
512 | all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool | |
513 | all predicate = P.all (T.all predicate) | |
514 | {-# INLINABLE all #-} | |
515 | ||
516 | -- | Return the maximum 'Char' within a byte stream | |
517 | maximum :: (Monad m) => Producer Text m () -> m (Maybe Char) | |
518 | maximum = P.fold step Nothing id | |
519 | where | |
520 | step mw8 bs = | |
521 | if (T.null bs) | |
522 | then mw8 | |
523 | else Just $ case mw8 of | |
524 | Nothing -> T.maximum bs | |
525 | Just w8 -> max w8 (T.maximum bs) | |
526 | {-# INLINABLE maximum #-} | |
527 | ||
528 | -- | Return the minimum 'Char' within a byte stream | |
529 | minimum :: (Monad m) => Producer Text m () -> m (Maybe Char) | |
530 | minimum = P.fold step Nothing id | |
531 | where | |
532 | step mw8 bs = | |
533 | if (T.null bs) | |
534 | then mw8 | |
535 | else case mw8 of | |
536 | Nothing -> Just (T.minimum bs) | |
537 | Just w8 -> Just (min w8 (T.minimum bs)) | |
538 | {-# INLINABLE minimum #-} | |
539 | ||
540 | -- | Determine whether any element in the byte stream matches the given 'Char' | |
541 | -- elem :: (Monad m) => Char -> Producer Text m () -> m Bool | |
542 | -- elem w8 = P.any (T.elem w8) | |
543 | -- {-# INLINABLE elem #-} | |
544 | -- | |
545 | -- {-| Determine whether all elements in the byte stream do not match the given | |
546 | -- 'Char' | |
547 | -- -} | |
548 | -- notElem :: (Monad m) => Char -> Producer Text m () -> m Bool | |
549 | -- notElem w8 = P.all (T.notElem w8) | |
550 | -- {-# INLINABLE notElem #-} | |
551 | ||
552 | -- | Find the first element in the stream that matches the predicate | |
553 | find | |
554 | :: (Monad m) | |
555 | => (Char -> Bool) -> Producer Text m () -> m (Maybe Char) | |
556 | find predicate p = head (p >-> filter predicate) | |
557 | {-# INLINABLE find #-} | |
558 | ||
559 | -- | Index into a byte stream | |
560 | index | |
561 | :: (Monad m, Integral a) | |
562 | => a-> Producer Text m () -> m (Maybe Char) | |
563 | index n p = head (p >-> drop n) | |
564 | {-# INLINABLE index #-} | |
565 | ||
566 | -- | Find the index of an element that matches the given 'Char' | |
567 | -- elemIndex | |
568 | -- :: (Monad m, Num n) => Char -> Producer Text m () -> m (Maybe n) | |
569 | -- elemIndex w8 = findIndex (w8 ==) | |
570 | -- {-# INLINABLE elemIndex #-} | |
571 | ||
572 | -- | Store the first index of an element that satisfies the predicate | |
573 | -- findIndex | |
574 | -- :: (Monad m, Num n) | |
575 | -- => (Char -> Bool) -> Producer Text m () -> m (Maybe n) | |
576 | -- findIndex predicate p = P.head (p >-> findIndices predicate) | |
577 | -- {-# INLINABLE findIndex #-} | |
578 | -- | |
579 | -- -- | Store a tally of how many elements match the given 'Char' | |
580 | -- count :: (Monad m, Num n) => Char -> Producer Text m () -> m n | |
581 | -- count w8 p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count w8)) | |
582 | -- {-# INLINABLE count #-} | |
583 | ||
584 | -- | Splits a 'Producer' after the given number of bytes | |
585 | splitAt | |
586 | :: (Monad m, Integral n) | |
587 | => n | |
588 | -> Producer Text m r | |
589 | -> Producer' Text m (Producer Text m r) | |
590 | splitAt = go | |
591 | where | |
592 | go 0 p = return p | |
593 | go n p = do | |
594 | x <- lift (next p) | |
595 | case x of | |
596 | Left r -> return (return r) | |
597 | Right (bs, p') -> do | |
598 | let len = fromIntegral (T.length bs) | |
599 | if (len <= n) | |
600 | then do | |
601 | yield bs | |
602 | go (n - len) p' | |
603 | else do | |
604 | let (prefix, suffix) = T.splitAt (fromIntegral n) bs | |
605 | yield prefix | |
606 | return (yield suffix >> p') | |
607 | {-# INLINABLE splitAt #-} | |
608 | ||
609 | -- | Split a byte stream into 'FreeT'-delimited byte streams of fixed size | |
610 | chunksOf | |
611 | :: (Monad m, Integral n) | |
612 | => n -> Producer Text m r -> FreeT (Producer Text m) m r | |
613 | chunksOf n p0 = PP.FreeT (go p0) | |
614 | where | |
615 | go p = do | |
616 | x <- next p | |
617 | return $ case x of | |
618 | Left r -> PP.Pure r | |
619 | Right (bs, p') -> PP.Free $ do | |
620 | p'' <- splitAt n (yield bs >> p') | |
621 | return $ PP.FreeT (go p'') | |
622 | {-# INLINABLE chunksOf #-} | |
623 | ||
624 | {-| Split a byte stream in two, where the first byte stream is the longest | |
625 | consecutive group of bytes that satisfy the predicate | |
626 | -} | |
627 | span | |
628 | :: (Monad m) | |
629 | => (Char -> Bool) | |
630 | -> Producer Text m r | |
631 | -> Producer' Text m (Producer Text m r) | |
632 | span predicate = go | |
633 | where | |
634 | go p = do | |
635 | x <- lift (next p) | |
636 | case x of | |
637 | Left r -> return (return r) | |
638 | Right (bs, p') -> do | |
639 | let (prefix, suffix) = T.span predicate bs | |
640 | if (T.null suffix) | |
641 | then do | |
642 | yield bs | |
643 | go p' | |
644 | else do | |
645 | yield prefix | |
646 | return (yield suffix >> p') | |
647 | {-# INLINABLE span #-} | |
648 | ||
649 | {-| Split a byte stream in two, where the first byte stream is the longest | |
650 | consecutive group of bytes that don't satisfy the predicate | |
651 | -} | |
652 | break | |
653 | :: (Monad m) | |
654 | => (Char -> Bool) | |
655 | -> Producer Text m r | |
656 | -> Producer Text m (Producer Text m r) | |
657 | break predicate = span (not . predicate) | |
658 | {-# INLINABLE break #-} | |
659 | ||
660 | {-| Split a byte stream into sub-streams delimited by bytes that satisfy the | |
661 | predicate | |
662 | -} | |
663 | splitWith | |
664 | :: (Monad m) | |
665 | => (Char -> Bool) | |
666 | -> Producer Text m r | |
667 | -> PP.FreeT (Producer Text m) m r | |
668 | splitWith predicate p0 = PP.FreeT (go0 p0) | |
669 | where | |
670 | go0 p = do | |
671 | x <- next p | |
672 | case x of | |
673 | Left r -> return (PP.Pure r) | |
674 | Right (bs, p') -> | |
675 | if (T.null bs) | |
676 | then go0 p' | |
677 | else return $ PP.Free $ do | |
678 | p'' <- span (not . predicate) (yield bs >> p') | |
679 | return $ PP.FreeT (go1 p'') | |
680 | go1 p = do | |
681 | x <- nextChar p | |
682 | return $ case x of | |
683 | Left r -> PP.Pure r | |
684 | Right (_, p') -> PP.Free $ do | |
685 | p'' <- span (not . predicate) p' | |
686 | return $ PP.FreeT (go1 p'') | |
687 | {-# INLINABLE splitWith #-} | |
688 | ||
689 | -- | Split a byte stream using the given 'Char' as the delimiter | |
690 | split :: (Monad m) | |
691 | => Char | |
692 | -> Producer Text m r | |
693 | -> FreeT (Producer Text m) m r | |
694 | split w8 = splitWith (w8 ==) | |
695 | {-# INLINABLE split #-} | |
696 | ||
697 | {-| Group a byte stream into 'FreeT'-delimited byte streams using the supplied | |
698 | equality predicate | |
699 | -} | |
700 | groupBy | |
701 | :: (Monad m) | |
702 | => (Char -> Char -> Bool) | |
703 | -> Producer Text m r | |
704 | -> FreeT (Producer Text m) m r | |
705 | groupBy equal p0 = PP.FreeT (go p0) | |
706 | where | |
707 | go p = do | |
708 | x <- next p | |
709 | case x of | |
710 | Left r -> return (PP.Pure r) | |
711 | Right (bs, p') -> case (T.uncons bs) of | |
712 | Nothing -> go p' | |
713 | Just (w8, _) -> do | |
714 | return $ PP.Free $ do | |
715 | p'' <- span (equal w8) (yield bs >> p') | |
716 | return $ PP.FreeT (go p'') | |
717 | {-# INLINABLE groupBy #-} | |
718 | ||
719 | -- | Group a byte stream into 'FreeT'-delimited byte streams of identical bytes | |
720 | group | |
721 | :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r | |
722 | group = groupBy (==) | |
723 | {-# INLINABLE group #-} | |
724 | ||
725 | {-| Split a byte stream into 'FreeT'-delimited lines | |
726 | ||
727 | Note: This function is purely for demonstration purposes since it assumes a | |
728 | particular encoding. You should prefer the 'Data.Text.Text' equivalent of | |
729 | this function from the upcoming @pipes-text@ library. | |
730 | -} | |
731 | lines | |
732 | :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r | |
733 | lines p0 = PP.FreeT (go0 p0) | |
734 | where | |
735 | go0 p = do | |
736 | x <- next p | |
737 | case x of | |
738 | Left r -> return (PP.Pure r) | |
739 | Right (bs, p') -> | |
740 | if (T.null bs) | |
741 | then go0 p' | |
742 | else return $ PP.Free $ go1 (yield bs >> p') | |
743 | go1 p = do | |
744 | p' <- break ('\n' ==) p | |
745 | return $ PP.FreeT (go2 p') | |
746 | go2 p = do | |
747 | x <- nextChar p | |
748 | return $ case x of | |
749 | Left r -> PP.Pure r | |
750 | Right (_, p') -> PP.Free (go1 p') | |
751 | {-# INLINABLE lines #-} | |
752 | nextChar = undefined | |
753 | {-| Split a byte stream into 'FreeT'-delimited words | |
754 | ||
755 | Note: This function is purely for demonstration purposes since it assumes a | |
756 | particular encoding. You should prefer the 'Data.Text.Text' equivalent of | |
757 | this function from the upcoming @pipes-text@ library. | |
758 | -} | |
759 | words | |
760 | :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r | |
761 | words p0 = removeEmpty (splitWith isSpace p0) | |
762 | where | |
763 | removeEmpty f = PP.FreeT $ do | |
764 | x <- PP.runFreeT f | |
765 | case x of | |
766 | PP.Pure r -> return (PP.Pure r) | |
767 | PP.Free p -> do | |
768 | y <- next p | |
769 | case y of | |
770 | Left f' -> PP.runFreeT (removeEmpty f') | |
771 | Right (bs, p') -> return $ PP.Free $ do | |
772 | yield bs | |
773 | f' <- p' | |
774 | return (removeEmpty f') | |
775 | {-# INLINABLE words #-} | |
776 | ||
777 | -- | Intersperse a 'Char' in between the bytes of the byte stream | |
778 | intersperse | |
779 | :: (Monad m) => Char -> Producer Text m r -> Producer Text m r | |
780 | intersperse w8 = go0 | |
781 | where | |
782 | go0 p = do | |
783 | x <- lift (next p) | |
784 | case x of | |
785 | Left r -> return r | |
786 | Right (bs, p') -> do | |
787 | yield (T.intersperse w8 bs) | |
788 | go1 p' | |
789 | go1 p = do | |
790 | x <- lift (next p) | |
791 | case x of | |
792 | Left r -> return r | |
793 | Right (bs, p') -> do | |
794 | yield (T.singleton w8) | |
795 | yield (T.intersperse w8 bs) | |
796 | go1 p' | |
797 | {-# INLINABLE intersperse #-} | |
798 | ||
799 | {-| 'intercalate' concatenates the 'FreeT'-delimited byte streams after | |
800 | interspersing a byte stream in between them | |
801 | -} | |
802 | intercalate | |
803 | :: (Monad m) | |
804 | => Producer Text m () | |
805 | -> FreeT (Producer Text m) m r | |
806 | -> Producer Text m r | |
807 | intercalate p0 = go0 | |
808 | where | |
809 | go0 f = do | |
810 | x <- lift (PP.runFreeT f) | |
811 | case x of | |
812 | PP.Pure r -> return r | |
813 | PP.Free p -> do | |
814 | f' <- p | |
815 | go1 f' | |
816 | go1 f = do | |
817 | x <- lift (PP.runFreeT f) | |
818 | case x of | |
819 | PP.Pure r -> return r | |
820 | PP.Free p -> do | |
821 | p0 | |
822 | f' <- p | |
823 | go1 f' | |
824 | {-# INLINABLE intercalate #-} | |
825 | ||
826 | {-| Join 'FreeT'-delimited lines into a byte stream | |
827 | ||
828 | Note: This function is purely for demonstration purposes since it assumes a | |
829 | particular encoding. You should prefer the 'Data.Text.Text' equivalent of | |
830 | this function from the upcoming @pipes-text@ library. | |
831 | -} | |
832 | unlines | |
833 | :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r | |
834 | unlines = go | |
835 | where | |
836 | go f = do | |
837 | x <- lift (PP.runFreeT f) | |
838 | case x of | |
839 | PP.Pure r -> return r | |
840 | PP.Free p -> do | |
841 | f' <- p | |
842 | yield $ T.singleton '\n' | |
843 | go f' | |
844 | {-# INLINABLE unlines #-} | |
845 | ||
846 | {-| Join 'FreeT'-delimited words into a byte stream | |
847 | ||
848 | Note: This function is purely for demonstration purposes since it assumes a | |
849 | particular encoding. You should prefer the 'Data.Text.Text' equivalent of | |
850 | this function from the upcoming @pipes-text@ library. | |
851 | -} | |
852 | unwords | |
853 | :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r | |
854 | unwords = intercalate (yield $ T.pack " ") | |
855 | {-# INLINABLE unwords #-} | |
856 | ||
857 | {- $parse | |
858 | The following parsing utilities are single-byte analogs of the ones found | |
859 | in @pipes-parse@. | |
860 | -} | |
861 | ||
862 | {-| Take bytes until they fail the predicate | |
863 | ||
864 | Unlike 'takeWhile', this 'PP.unDraw's unused bytes | |
865 | -} | |
866 | -- takeWhile' | |
867 | -- :: (Monad m) | |
868 | -- => (Char -> Bool) | |
869 | -- -> Pipe Text Text (StateT (Producer Text m r) m) () | |
870 | -- takeWhile' = PBP.takeWhile | |
871 | -- {-# INLINABLE takeWhile' #-} | |
872 | -- {-# DEPRECATED takeWhile' "Use Pipes.Text.Parse.takeWhile instead" #-} | |
873 | ||
874 | {- $reexports | |
875 | "Pipes.Text.Parse" re-exports 'nextByte', 'drawByte', 'unDrawByte', | |
876 | 'peekByte', and 'isEndOfBytes'. | |
877 | ||
878 | @Data.Text@ re-exports the 'Text' type. | |
879 | ||
880 | @Data.Word@ re-exports the 'Char' type. | |
881 | ||
882 | @Pipes.Parse@ re-exports 'input', 'concat', and 'FreeT' (the type). | |
883 | -} |