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