]> git.immae.eu Git - github/fretlink/text-pipes.git/blame_incremental - Pipes/Text.hs
encoding documentation beginning to improve
[github/fretlink/text-pipes.git] / Pipes / Text.hs
... / ...
CommitLineData
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
22To 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
63module 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
143import Control.Applicative ((<*))
144import Control.Monad (liftM, join)
145import Control.Monad.Trans.State.Strict (StateT(..), modify)
146import qualified Data.Text as T
147import Data.Text (Text)
148import qualified Data.Text.Lazy as TL
149import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize)
150import Data.ByteString (ByteString)
151import Data.Functor.Constant (Constant(Constant, getConstant))
152import Data.Functor.Identity (Identity)
153import Data.Profunctor (Profunctor)
154import qualified Data.Profunctor
155import Pipes
156import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..))
157import qualified Pipes.Group as PG
158import qualified Pipes.Parse as PP
159import Pipes.Parse (Parser)
160import qualified Pipes.Prelude as P
161import Data.Char (isSpace)
162import Data.Word (Word8)
163
164import 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
194fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
195fromLazy = foldrChunks (\e a -> yield e >> a) (return ())
196{-# INLINE fromLazy #-}
197
198
199type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
200
201type 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
204a ^. lens = getConstant (lens Constant a)
205
206
207-- | Apply a transformation to each 'Char' in the stream
208map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
209map 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
217concatMap
218 :: (Monad m) => (Char -> Text) -> Pipe Text Text m r
219concatMap 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
228pack :: Monad m => Pipe String Text m r
229pack = 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
237unpack :: Monad m => Pipe Text String m r
238unpack = 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
247toCaseFold :: Monad m => Pipe Text Text m ()
248toCaseFold = 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'
257toLower :: Monad m => Pipe Text Text m ()
258toLower = 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'
266toUpper :: Monad m => Pipe Text Text m ()
267toUpper = 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
275stripStart :: Monad m => Pipe Text Text m r
276stripStart = 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.
287take :: (Monad m, Integral a) => a -> Pipe Text Text m ()
288take 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
302drop :: (Monad m, Integral a) => a -> Pipe Text Text m r
303drop 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
317takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m ()
318takeWhile 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
331dropWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
332dropWhile 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
343filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
344filter 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
352scan
353 :: (Monad m)
354 => (Char -> Char -> Char) -> Char -> Pipe Text Text m r
355scan 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-}
370toLazy :: Producer Text Identity () -> TL.Text
371toLazy = 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-}
381toLazyM :: (Monad m) => Producer Text m () -> m TL.Text
382toLazyM = liftM TL.fromChunks . P.toListM
383{-# INLINABLE toLazyM #-}
384
385-- | Reduce the text stream using a strict left fold over characters
386foldChars
387 :: Monad m
388 => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r
389foldChars step begin done = P.fold (T.foldl' step) begin done
390{-# INLINABLE foldChars #-}
391
392-- | Retrieve the first 'Char'
393head :: (Monad m) => Producer Text m () -> m (Maybe Char)
394head = 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'
404last :: (Monad m) => Producer Text m () -> m (Maybe Char)
405last = 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
418null :: (Monad m) => Producer Text m () -> m Bool
419null = P.all T.null
420{-# INLINABLE null #-}
421
422-- | Count the number of characters in the stream
423length :: (Monad m, Num n) => Producer Text m () -> m n
424length = 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
428any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
429any predicate = P.any (T.any predicate)
430{-# INLINABLE any #-}
431
432-- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate
433all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
434all predicate = P.all (T.all predicate)
435{-# INLINABLE all #-}
436
437-- | Return the maximum 'Char' within a text stream
438maximum :: (Monad m) => Producer Text m () -> m (Maybe Char)
439maximum = 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!)
450minimum :: (Monad m) => Producer Text m () -> m (Maybe Char)
451minimum = 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
462find
463 :: (Monad m)
464 => (Char -> Bool) -> Producer Text m () -> m (Maybe Char)
465find predicate p = head (p >-> filter predicate)
466{-# INLINABLE find #-}
467
468-- | Index into a text stream
469index
470 :: (Monad m, Integral a)
471 => a-> Producer Text m () -> m (Maybe Char)
472index n p = head (p >-> drop n)
473{-# INLINABLE index #-}
474
475
476-- | Store a tally of how many segments match the given 'Text'
477count :: (Monad m, Num n) => Text -> Producer Text m () -> m n
478count 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
488nextChar
489 :: (Monad m)
490 => Producer Text m r
491 -> m (Either r (Char, Producer Text m r))
492nextChar = 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
505drawChar :: (Monad m) => Parser Text m (Maybe Char)
506drawChar = 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'
518unDrawChar :: (Monad m) => Char -> Parser Text m ()
519unDrawChar 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
534peekChar :: (Monad m) => Parser Text m (Maybe Char)
535peekChar = 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-}
551isEndOfChars :: (Monad m) => Parser Text m Bool
552isEndOfChars = 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
561splitAt
562 :: (Monad m, Integral n)
563 => n
564 -> Lens' (Producer Text m r)
565 (Producer Text m (Producer Text m r))
566splitAt 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
590span
591 :: (Monad m)
592 => (Char -> Bool)
593 -> Lens' (Producer Text m r)
594 (Producer Text m (Producer Text m r))
595span 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-}
615break
616 :: (Monad m)
617 => (Char -> Bool)
618 -> Lens' (Producer Text m r)
619 (Producer Text m (Producer Text m r))
620break 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-}
626groupBy
627 :: (Monad m)
628 => (Char -> Char -> Bool)
629 -> Lens' (Producer Text m r)
630 (Producer Text m (Producer Text m r))
631groupBy 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
642group :: Monad m
643 => Lens' (Producer Text m r)
644 (Producer Text m (Producer Text m r))
645group = 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-}
652word :: (Monad m)
653 => Lens' (Producer Text m r)
654 (Producer Text m (Producer Text m r))
655word 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
663line :: (Monad m)
664 => Lens' (Producer Text m r)
665 (Producer Text m (Producer Text m r))
666line = break (== '\n')
667
668{-# INLINABLE line #-}
669
670
671-- | Intersperse a 'Char' in between the characters of stream of 'Text'
672intersperse
673 :: (Monad m) => Char -> Producer Text m r -> Producer Text m r
674intersperse 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
696packChars :: Monad m => Iso' (Producer Char m x) (Producer Text m x)
697packChars = 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
712chunksOf
713 :: (Monad m, Integral n)
714 => n -> Lens' (Producer Text m r)
715 (FreeT (Producer Text m) m r)
716chunksOf 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-}
731splitsWith
732 :: (Monad m)
733 => (Char -> Bool)
734 -> Producer Text m r
735 -> FreeT (Producer Text m) m r
736splitsWith 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
758splits :: (Monad m)
759 => Char
760 -> Lens' (Producer Text m r)
761 (FreeT (Producer Text m) m r)
762splits 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-}
769groupsBy
770 :: Monad m
771 => (Char -> Char -> Bool)
772 -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x)
773groupsBy 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 ('==')
785groups
786 :: Monad m
787 => Lens' (Producer Text m x) (FreeT (Producer Text m) m x)
788groups = groupsBy (==)
789{-# INLINABLE groups #-}
790
791
792
793{-| Split a text stream into 'FreeT'-delimited lines
794-}
795lines
796 :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r)
797lines = 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
826words
827 :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r)
828words = 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-}
845intercalate
846 :: (Monad m)
847 => Producer Text m ()
848 -> FreeT (Producer Text m) m r
849 -> Producer Text m r
850intercalate 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-}
871unlines
872 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
873unlines = 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-}
887unwords
888 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
889unwords = 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