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