]> git.immae.eu Git - github/fretlink/text-pipes.git/blame - Pipes/Text.hs
words
[github/fretlink/text-pipes.git] / Pipes / Text.hs
CommitLineData
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
19To 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 59module 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
144import Control.Exception (throwIO, try)
145import Control.Monad (liftM, unless)
acc6868f 146import Control.Monad.Trans.State.Strict (StateT(..))
91727d11 147import qualified Data.Text as T
148import qualified Data.Text.IO as T
31f41a5d 149import qualified Data.Text.Encoding as TE
91727d11 150import Data.Text (Text)
151import qualified Data.Text.Lazy as TL
152import qualified Data.Text.Lazy.IO as TL
153import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize)
154import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)
31f41a5d 155import Data.ByteString (ByteString)
156import qualified Data.ByteString as B
91727d11 157import Data.Char (ord)
158import Data.Functor.Identity (Identity)
159import qualified Data.List as List
160import Foreign.C.Error (Errno(Errno), ePIPE)
161import qualified GHC.IO.Exception as G
162import Pipes
163import qualified Pipes.ByteString.Parse as PBP
c0343bc9 164import Pipes.Text.Parse (
31f41a5d 165 nextChar, drawChar, unDrawChar, peekChar, isEndOfChars )
91727d11 166import Pipes.Core (respond, Server')
167import qualified Pipes.Parse as PP
168import Pipes.Parse (input, concat, FreeT)
169import qualified Pipes.Safe.Prelude as Safe
170import qualified Pipes.Safe as Safe
171import Pipes.Safe (MonadSafe(..), Base(..))
172import qualified Pipes.Prelude as P
173import qualified System.IO as IO
174import Data.Char (isSpace)
175import 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
205fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
206fromLazy = foldrChunks (\e a -> yield e >> a) (return ())
207{-# INLINABLE fromLazy #-}
208
62e8521c 209-- | Stream text from 'stdin'
91727d11 210stdin :: MonadIO m => Producer' Text m ()
211stdin = 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 219fromHandle :: MonadIO m => IO.Handle -> Producer' Text m ()
220fromHandle 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
229MAIN = PUTSTRLN "HELLO WORLD"
6f6f9974 230-}
231
91727d11 232readFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Producer' Text m ()
233readFile 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)
240hello
2415
242world
2435
244
245-}
91727d11 246stdinLn :: MonadIO m => Producer' Text m ()
31f41a5d 247stdinLn = 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-}
263stdout :: MonadIO m => Consumer' Text m ()
264stdout = 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
278stdoutLn :: (MonadIO m) => Consumer' Text m ()
279stdoutLn = 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-}
298toHandle :: MonadIO m => IO.Handle -> Consumer' Text m r
299toHandle h = for cat (liftIO . T.hPutStr h)
300{-# INLINABLE toHandle #-}
301
31f41a5d 302-- | Stream text into a file. Uses @pipes-safe@.
91727d11 303writeFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Consumer' Text m ()
304writeFile file = Safe.withFile file IO.WriteMode toHandle
305
306-- | Apply a transformation to each 'Char' in the stream
307map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
308map 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 312concatMap
313 :: (Monad m) => (Char -> Text) -> Pipe Text Text m r
314concatMap 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
320encodeUtf8 :: Monad m => Pipe Text ByteString m r
321encodeUtf8 = P.map TE.encodeUtf8
322{-# INLINEABLE encodeUtf8 #-}
323
c0343bc9 324-- | Transform a Pipe of 'String's into one of 'Text' chunks
7faef8bc 325pack :: Monad m => Pipe String Text m r
326pack = P.map T.pack
327{-# INLINEABLE pack #-}
328
c0343bc9 329-- | Transforma a Pipes of 'Text' chunks into one of 'String's
7faef8bc 330unpack :: Monad m => Pipe Text String m r
331unpack = 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
336toCaseFold :: Monad m => Pipe Text Text m ()
337toCaseFold = P.map T.toCaseFold
338{-# INLINEABLE toCaseFold #-}
339
c0343bc9 340-- | lowercase incoming 'Text'
7faef8bc 341toLower :: Monad m => Pipe Text Text m ()
342toLower = P.map T.toLower
343{-# INLINEABLE toLower #-}
344
c0343bc9 345-- | uppercase incoming 'Text'
7faef8bc 346toUpper :: Monad m => Pipe Text Text m ()
347toUpper = P.map T.toUpper
348{-# INLINEABLE toUpper #-}
349
c0343bc9 350-- | Remove leading white space from an incoming succession of 'Text's
7faef8bc 351stripStart :: Monad m => Pipe Text Text m r
352stripStart = 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 362take :: (Monad m, Integral a) => a -> Pipe Text Text m ()
363take 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 377drop :: (Monad m, Integral a) => a -> Pipe Text Text m r
378drop 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 392takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m ()
393takeWhile 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 406dropWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
407dropWhile 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
418filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
419filter predicate = P.map (T.filter predicate)
420{-# INLINABLE filter #-}
421
31f41a5d 422
423-- | Strict left scan over the characters
91727d11 424scan
425 :: (Monad m)
426 => (Char -> Char -> Char) -> Char -> Pipe Text Text m r
427scan 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-}
440toLazy :: Producer Text Identity () -> TL.Text
441toLazy = 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-}
451toLazyM :: (Monad m) => Producer Text m () -> m TL.Text
452toLazyM = liftM TL.fromChunks . P.toListM
453{-# INLINABLE toLazyM #-}
454
31f41a5d 455-- | Reduce the text stream using a strict left fold over characters
91727d11 456fold
457 :: Monad m
458 => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r
31f41a5d 459fold step begin done = P.fold (T.foldl' step) begin done
91727d11 460{-# INLINABLE fold #-}
461
462-- | Retrieve the first 'Char'
463head :: (Monad m) => Producer Text m () -> m (Maybe Char)
464head = 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'
474last :: (Monad m) => Producer Text m () -> m (Maybe Char)
475last = 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
488null :: (Monad m) => Producer Text m () -> m Bool
489null = P.all T.null
490{-# INLINABLE null #-}
491
62e8521c 492-- | Count the number of characters in the stream
91727d11 493length :: (Monad m, Num n) => Producer Text m () -> m n
31f41a5d 494length = 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
498any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
499any predicate = P.any (T.any predicate)
500{-# INLINABLE any #-}
501
502-- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate
503all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
504all predicate = P.all (T.all predicate)
505{-# INLINABLE all #-}
506
62e8521c 507-- | Return the maximum 'Char' within a text stream
91727d11 508maximum :: (Monad m) => Producer Text m () -> m (Maybe Char)
509maximum = 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 520minimum :: (Monad m) => Producer Text m () -> m (Maybe Char)
521minimum = 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
532find
533 :: (Monad m)
534 => (Char -> Bool) -> Producer Text m () -> m (Maybe Char)
535find predicate p = head (p >-> filter predicate)
536{-# INLINABLE find #-}
537
62e8521c 538-- | Index into a text stream
91727d11 539index
540 :: (Monad m, Integral a)
541 => a-> Producer Text m () -> m (Maybe Char)
542index 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'
559count :: (Monad m, Num n) => Text -> Producer Text m () -> m n
560count 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
566decodeUtf8
567 :: Monad m
568 => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
569decodeUtf8 = 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 587splitAt
588 :: (Monad m, Integral n)
589 => n
590 -> Producer Text m r
591 -> Producer' Text m (Producer Text m r)
592splitAt = 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 612chunksOf
613 :: (Monad m, Integral n)
614 => n -> Producer Text m r -> FreeT (Producer Text m) m r
615chunksOf 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-}
629span
630 :: (Monad m)
631 => (Char -> Bool)
632 -> Producer Text m r
633 -> Producer' Text m (Producer Text m r)
634span 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-}
654break
655 :: (Monad m)
656 => (Char -> Bool)
657 -> Producer Text m r
658 -> Producer Text m (Producer Text m r)
659break 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-}
665splitWith
666 :: (Monad m)
667 => (Char -> Bool)
668 -> Producer Text m r
669 -> PP.FreeT (Producer Text m) m r
670splitWith 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 692split :: (Monad m)
693 => Char
694 -> Producer Text m r
695 -> FreeT (Producer Text m) m r
31f41a5d 696split 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-}
702groupBy
703 :: (Monad m)
704 => (Char -> Char -> Bool)
705 -> Producer Text m r
706 -> FreeT (Producer Text m) m r
707groupBy 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 722group
723 :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
724group = groupBy (==)
725{-# INLINABLE group #-}
726
62e8521c 727{-| Split a text stream into 'FreeT'-delimited lines
91727d11 728-}
729lines
730 :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
731lines 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 754words
755 :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
756words 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 777intersperse
778 :: (Monad m) => Char -> Producer Text m r -> Producer Text m r
31f41a5d 779intersperse 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-}
801intercalate
802 :: (Monad m)
803 => Producer Text m ()
804 -> FreeT (Producer Text m) m r
805 -> Producer Text m r
806intercalate 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-}
827unlines
828 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
829unlines = 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-}
843unwords
844 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
845unwords = 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-}