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