]> git.immae.eu Git - github/fretlink/text-pipes.git/blame - Pipes/Text.hs
clean up exports in Pipes.Text
[github/fretlink/text-pipes.git] / Pipes / Text.hs
CommitLineData
9667f797
GG
1{-# LANGUAGE RankNTypes, TypeFamilies, BangPatterns, Trustworthy #-}
2
13a43263 3{-| This module provides @pipes@ utilities for \"text streams\", which are
64e03122 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.
91727d11 8
63ea9ffd 9 To stream to or from 'IO.Handle's, one can use 'fromHandle' or 'toHandle'. For
31f41a5d 10 example, the following program copies a document from one file to another:
91727d11 11
12> import Pipes
bbdfd305 13> import qualified Pipes.Text as Text
14> import qualified Pipes.Text.IO as Text
91727d11 15> import System.IO
16>
17> main =
18> withFile "inFile.txt" ReadMode $ \hIn ->
19> withFile "outFile.txt" WriteMode $ \hOut ->
31f41a5d 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):
91727d11 23
13a43263 24> import Pipes
bbdfd305 25> import qualified Pipes.Text as Text
26> import qualified Pipes.Text.IO as Text
13a43263 27> import Pipes.Safe
28>
31f41a5d 29> main = runSafeT $ runEffect $ Text.readFile "inFile.txt" >-> Text.writeFile "outFile.txt"
13a43263 30
91727d11 31 You can stream to and from 'stdin' and 'stdout' using the predefined 'stdin'
c8027236 32 and 'stdout' pipes, as with the following \"echo\" program:
91727d11 33
31f41a5d 34> main = runEffect $ Text.stdin >-> Text.stdout
91727d11 35
c8027236 36 You can also translate pure lazy 'TL.Text's to and from pipes:
91727d11 37
31f41a5d 38> main = runEffect $ Text.fromLazy (TL.pack "Hello, world!\n") >-> Text.stdout
91727d11 39
40 In addition, this module provides many functions equivalent to lazy
31f41a5d 41 'Text' functions so that you can transform or fold text streams. For
91727d11 42 example, to stream only the first three lines of 'stdin' to 'stdout' you
31f41a5d 43 might write:
91727d11 44
45> import Pipes
31f41a5d 46> import qualified Pipes.Text as Text
47> import qualified Pipes.Parse as Parse
91727d11 48>
31f41a5d 49> main = runEffect $ takeLines 3 Text.stdin >-> Text.stdout
91727d11 50> where
31f41a5d 51> takeLines n = Text.unlines . Parse.takeFree n . Text.lines
91727d11 52
31f41a5d 53 The above program will never bring more than one chunk of text (~ 32 KB) into
91727d11 54 memory, no matter how long the lines are.
55
56 Note that functions in this library are designed to operate on streams that
31f41a5d 57 are insensitive to text boundaries. This means that they may freely split
64e03122 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'.
91727d11 61-}
62
7faef8bc 63module Pipes.Text (
91727d11 64 -- * Producers
1a83ae4e 65 fromLazy
91727d11 66
67 -- * Pipes
1677dc12 68 , map
69 , concatMap
70 , take
71 , drop
72 , takeWhile
73 , dropWhile
74 , filter
75 , scan
1677dc12 76 , pack
77 , unpack
78 , toCaseFold
79 , toLower
80 , toUpper
81 , stripStart
91727d11 82
83 -- * Folds
1677dc12 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
9e9bb0ce 105 , isEndOfChars
1677dc12 106
107 -- * Parsing Lenses
9e9bb0ce 108 , splitAt
1677dc12 109 , span
110 , break
111 , groupBy
112 , group
9e9bb0ce 113 , word
114 , line
1677dc12 115
116 -- * FreeT Splitters
117 , chunksOf
118 , splitsWith
0f8c6f1b 119 , splits
1a83ae4e 120 , groupsBy
121 , groups
1677dc12 122 , lines
123 , words
124
91727d11 125 -- * Transformations
1677dc12 126 , intersperse
9e9bb0ce 127 , packChars
31f41a5d 128
91727d11 129 -- * Joiners
1677dc12 130 , intercalate
131 , unlines
132 , unwords
9e9bb0ce 133
1a83ae4e 134 -- * Re-exports
91727d11 135 -- $reexports
1677dc12 136 , module Data.ByteString
137 , module Data.Text
138 , module Data.Profunctor
1677dc12 139 , module Pipes.Parse
7ed76745 140 , module Pipes.Group
91727d11 141 ) where
142
0f8c6f1b 143import Control.Applicative ((<*))
70125641 144import Control.Monad (liftM, join)
9e9bb0ce 145import Control.Monad.Trans.State.Strict (StateT(..), modify)
91727d11 146import qualified Data.Text as T
91727d11 147import Data.Text (Text)
148import qualified Data.Text.Lazy as TL
91727d11 149import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize)
31f41a5d 150import Data.ByteString (ByteString)
1677dc12 151import Data.Functor.Constant (Constant(Constant, getConstant))
91727d11 152import Data.Functor.Identity (Identity)
1677dc12 153import Data.Profunctor (Profunctor)
154import qualified Data.Profunctor
91727d11 155import Pipes
7fc48f7c 156import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..))
7ed76745 157import qualified Pipes.Group as PG
91727d11 158import qualified Pipes.Parse as PP
7ed76745 159import Pipes.Parse (Parser)
91727d11 160import qualified Pipes.Prelude as P
91727d11 161import Data.Char (isSpace)
1a83ae4e 162import Data.Word (Word8)
1677dc12 163
91727d11 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 ())
ca6f90a0 196{-# INLINE fromLazy #-}
91727d11 197
1677dc12 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
91727d11 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
ff38b9f0 212{-# RULES "p >-> map f" forall p f .
213 p >-> map f = for p (\txt -> yield (T.map f txt))
214 #-}
215
31f41a5d 216-- | Map a function over the characters of a text stream and concatenate the results
91727d11 217concatMap
218 :: (Monad m) => (Char -> Text) -> Pipe Text Text m r
219concatMap f = P.map (T.concatMap f)
220{-# INLINABLE concatMap #-}
221
ff38b9f0 222{-# RULES "p >-> concatMap f" forall p f .
223 p >-> concatMap f = for p (\txt -> yield (T.concatMap f txt))
224 #-}
7faef8bc 225
ff38b9f0 226
c0343bc9 227-- | Transform a Pipe of 'String's into one of 'Text' chunks
7faef8bc 228pack :: Monad m => Pipe String Text m r
229pack = P.map T.pack
230{-# INLINEABLE pack #-}
231
ff38b9f0 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
7faef8bc 237unpack :: Monad m => Pipe Text String m r
d4732515 238unpack = for cat (\t -> yield (T.unpack t))
7faef8bc 239{-# INLINEABLE unpack #-}
240
ff38b9f0 241{-# RULES "p >-> unpack" forall p .
242 p >-> unpack = for p (\txt -> yield (T.unpack txt))
243 #-}
d4732515 244
b0d86a59 245-- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities,
246-- here acting as 'Text' pipes, rather as they would on a lazy text
7faef8bc 247toCaseFold :: Monad m => Pipe Text Text m ()
248toCaseFold = P.map T.toCaseFold
249{-# INLINEABLE toCaseFold #-}
250
ff38b9f0 251{-# RULES "p >-> toCaseFold" forall p .
252 p >-> toCaseFold = for p (\txt -> yield (T.toCaseFold txt))
253 #-}
254
255
c0343bc9 256-- | lowercase incoming 'Text'
7faef8bc 257toLower :: Monad m => Pipe Text Text m ()
258toLower = P.map T.toLower
259{-# INLINEABLE toLower #-}
260
ff38b9f0 261{-# RULES "p >-> toLower" forall p .
262 p >-> toLower = for p (\txt -> yield (T.toLower txt))
263 #-}
264
c0343bc9 265-- | uppercase incoming 'Text'
7faef8bc 266toUpper :: Monad m => Pipe Text Text m ()
267toUpper = P.map T.toUpper
268{-# INLINEABLE toUpper #-}
269
ff38b9f0 270{-# RULES "p >-> toUpper" forall p .
271 p >-> toUpper = for p (\txt -> yield (T.toUpper txt))
272 #-}
273
c0343bc9 274-- | Remove leading white space from an incoming succession of 'Text's
7faef8bc 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
b0d86a59 281 else do yield text
282 cat
7faef8bc 283{-# INLINEABLE stripStart #-}
284
31f41a5d 285-- | @(take n)@ only allows @n@ individual characters to pass;
286-- contrast @Pipes.Prelude.take@ which would let @n@ chunks pass.
91727d11 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
31f41a5d 292 txt <- await
293 let len = fromIntegral (T.length txt)
91727d11 294 if (len > n)
31f41a5d 295 then yield (T.take (fromIntegral n) txt)
91727d11 296 else do
31f41a5d 297 yield txt
91727d11 298 go (n - len)
299{-# INLINABLE take #-}
300
31f41a5d 301-- | @(drop n)@ drops the first @n@ characters
91727d11 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
31f41a5d 307 txt <- await
308 let len = fromIntegral (T.length txt)
91727d11 309 if (len >= n)
310 then do
31f41a5d 311 yield (T.drop (fromIntegral n) txt)
91727d11 312 cat
313 else go (n - len)
314{-# INLINABLE drop #-}
315
31f41a5d 316-- | Take characters until they fail the predicate
91727d11 317takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m ()
318takeWhile predicate = go
319 where
320 go = do
31f41a5d 321 txt <- await
322 let (prefix, suffix) = T.span predicate txt
91727d11 323 if (T.null suffix)
324 then do
31f41a5d 325 yield txt
91727d11 326 go
327 else yield prefix
328{-# INLINABLE takeWhile #-}
329
31f41a5d 330-- | Drop characters until they fail the predicate
91727d11 331dropWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
332dropWhile predicate = go where
333 go = do
31f41a5d 334 txt <- await
335 case T.findIndex (not . predicate) txt of
91727d11 336 Nothing -> go
337 Just i -> do
31f41a5d 338 yield (T.drop i txt)
91727d11 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
ff38b9f0 347{-# RULES "p >-> filter q" forall p q .
348 p >-> filter q = for p (\txt -> yield (T.filter q txt))
349 #-}
350
31f41a5d 351-- | Strict left scan over the characters
91727d11 352scan
353 :: (Monad m)
354 => (Char -> Char -> Char) -> Char -> Pipe Text Text m r
11645cdc
GG
355scan step begin = do
356 yield (T.singleton begin)
357 go begin
91727d11 358 where
31f41a5d 359 go c = do
360 txt <- await
361 let txt' = T.scanl step c txt
362 c' = T.last txt'
11645cdc 363 yield (T.tail txt')
31f41a5d 364 go c'
91727d11 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
31f41a5d 385-- | Reduce the text stream using a strict left fold over characters
64e03122 386foldChars
91727d11 387 :: Monad m
388 => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r
64e03122 389foldChars step begin done = P.fold (T.foldl' step) begin done
1677dc12 390{-# INLINABLE foldChars #-}
91727d11 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
31f41a5d 400 Right (c, _) -> return (Just c)
91727d11 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
31f41a5d 411 Right (txt, p') ->
412 if (T.null txt)
91727d11 413 then go r p'
31f41a5d 414 else go (Just $ T.last txt) p'
91727d11 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
62e8521c 422-- | Count the number of characters in the stream
91727d11 423length :: (Monad m, Num n) => Producer Text m () -> m n
31f41a5d 424length = P.fold (\n txt -> n + fromIntegral (T.length txt)) 0 id
91727d11 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
62e8521c 437-- | Return the maximum 'Char' within a text stream
91727d11 438maximum :: (Monad m) => Producer Text m () -> m (Maybe Char)
439maximum = P.fold step Nothing id
440 where
31f41a5d 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)
91727d11 447{-# INLINABLE maximum #-}
448
62e8521c 449-- | Return the minimum 'Char' within a text stream (surely very useful!)
91727d11 450minimum :: (Monad m) => Producer Text m () -> m (Maybe Char)
451minimum = P.fold step Nothing id
452 where
31f41a5d 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))
91727d11 459{-# INLINABLE minimum #-}
460
91727d11 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
62e8521c 468-- | Index into a text stream
91727d11 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
63ea9ffd 475
31f41a5d 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
9e9bb0ce 481
1a83ae4e 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'.
9e9bb0ce 487
9e9bb0ce 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
1a83ae4e 503-- | Draw one 'Char' from a stream of 'Text', returning 'Left' if the 'Producer' is empty
504
9e9bb0ce 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
1a83ae4e 531
9e9bb0ce 532-}
1a83ae4e 533
9e9bb0ce 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
31f41a5d 560-- | Splits a 'Producer' after the given number of characters
91727d11 561splitAt
562 :: (Monad m, Integral n)
563 => n
9e9bb0ce 564 -> Lens' (Producer Text m r)
565 (Producer Text m (Producer Text m r))
566splitAt n0 k p0 = fmap join (k (go n0 p0))
91727d11 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)
31f41a5d 573 Right (txt, p') -> do
574 let len = fromIntegral (T.length txt)
91727d11 575 if (len <= n)
576 then do
31f41a5d 577 yield txt
91727d11 578 go (n - len) p'
579 else do
31f41a5d 580 let (prefix, suffix) = T.splitAt (fromIntegral n) txt
91727d11 581 yield prefix
582 return (yield suffix >> p')
583{-# INLINABLE splitAt #-}
584
91727d11 585
1a83ae4e 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
91727d11 590span
591 :: (Monad m)
592 => (Char -> Bool)
9e9bb0ce 593 -> Lens' (Producer Text m r)
594 (Producer Text m (Producer Text m r))
595span predicate k p0 = fmap join (k (go p0))
91727d11 596 where
597 go p = do
598 x <- lift (next p)
599 case x of
600 Left r -> return (return r)
31f41a5d 601 Right (txt, p') -> do
602 let (prefix, suffix) = T.span predicate txt
91727d11 603 if (T.null suffix)
604 then do
31f41a5d 605 yield txt
91727d11 606 go p'
607 else do
608 yield prefix
609 return (yield suffix >> p')
610{-# INLINABLE span #-}
611
1a83ae4e 612{-| Split a text stream in two, producing the longest
62e8521c 613 consecutive group of characters that don't satisfy the predicate
91727d11 614-}
615break
616 :: (Monad m)
617 => (Char -> Bool)
9e9bb0ce 618 -> Lens' (Producer Text m r)
619 (Producer Text m (Producer Text m r))
91727d11 620break predicate = span (not . predicate)
621{-# INLINABLE break #-}
622
9e9bb0ce 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
7ed76745 700 to p = PG.folds step id done (p^.PG.chunksOf defaultChunkSize)
9e9bb0ce 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
0f8c6f1b 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
7ed76745 721 Left r -> Pure r
722 Right (txt, p') -> Free $ do
0f8c6f1b 723 p'' <- (yield txt >> p') ^. splitAt n
7ed76745 724 return $ FreeT (go p'')
0f8c6f1b 725{-# INLINABLE chunksOf #-}
726
727
62e8521c 728{-| Split a text stream into sub-streams delimited by characters that satisfy the
91727d11 729 predicate
730-}
1677dc12 731splitsWith
91727d11 732 :: (Monad m)
733 => (Char -> Bool)
734 -> Producer Text m r
7ed76745 735 -> FreeT (Producer Text m) m r
736splitsWith predicate p0 = FreeT (go0 p0)
91727d11 737 where
738 go0 p = do
739 x <- next p
740 case x of
7ed76745 741 Left r -> return (Pure r)
31f41a5d 742 Right (txt, p') ->
743 if (T.null txt)
91727d11 744 then go0 p'
7ed76745 745 else return $ Free $ do
9e9bb0ce 746 p'' <- (yield txt >> p') ^. span (not . predicate)
7ed76745 747 return $ FreeT (go1 p'')
91727d11 748 go1 p = do
749 x <- nextChar p
750 return $ case x of
7ed76745 751 Left r -> Pure r
752 Right (_, p') -> Free $ do
9e9bb0ce 753 p'' <- p' ^. span (not . predicate)
7ed76745 754 return $ FreeT (go1 p'')
1677dc12 755{-# INLINABLE splitsWith #-}
91727d11 756
31f41a5d 757-- | Split a text stream using the given 'Char' as the delimiter
0f8c6f1b 758splits :: (Monad m)
91727d11 759 => Char
0f8c6f1b 760 -> Lens' (Producer Text m r)
761 (FreeT (Producer Text m) m r)
762splits c k p =
7ed76745 763 fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p))
0f8c6f1b 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)
7ed76745 773groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
0f8c6f1b 774 go p = do x <- next p
7ed76745 775 case x of Left r -> return (Pure r)
0f8c6f1b 776 Right (bs, p') -> case T.uncons bs of
777 Nothing -> go p'
7ed76745 778 Just (c, _) -> do return $ Free $ do
0f8c6f1b 779 p'' <- (yield bs >> p')^.span (equals c)
7ed76745 780 return $ FreeT (go p'')
0f8c6f1b 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
91727d11 791
91727d11 792
62e8521c 793{-| Split a text stream into 'FreeT'-delimited lines
91727d11 794-}
795lines
0f8c6f1b 796 :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r)
797lines = Data.Profunctor.dimap _lines (fmap _unlines)
91727d11 798 where
7ed76745 799 _lines p0 = FreeT (go0 p0)
0f8c6f1b 800 where
801 go0 p = do
802 x <- next p
803 case x of
7ed76745 804 Left r -> return (Pure r)
0f8c6f1b 805 Right (txt, p') ->
806 if (T.null txt)
807 then go0 p'
7ed76745 808 else return $ Free $ go1 (yield txt >> p')
0f8c6f1b 809 go1 p = do
810 p' <- p ^. break ('\n' ==)
7ed76745 811 return $ FreeT $ do
0f8c6f1b 812 x <- nextChar p'
813 case x of
7ed76745 814 Left r -> return $ Pure r
0f8c6f1b 815 Right (_, p'') -> go0 p''
816 -- _unlines
817 -- :: Monad m
818 -- => FreeT (Producer Text m) m x -> Producer Text m x
7fc48f7c 819 _unlines = concats . PG.maps (<* yield (T.singleton '\n'))
820
0f8c6f1b 821
91727d11 822{-# INLINABLE lines #-}
91727d11 823
31f41a5d 824
31f41a5d 825-- | Split a text stream into 'FreeT'-delimited words
91727d11 826words
0f8c6f1b 827 :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r)
828words = Data.Profunctor.dimap go (fmap _unwords)
91727d11 829 where
7ed76745 830 go p = FreeT $ do
cf10d6f1 831 x <- next (p >-> dropWhile isSpace)
832 return $ case x of
7ed76745 833 Left r -> Pure r
834 Right (bs, p') -> Free $ do
9e9bb0ce 835 p'' <- (yield bs >> p') ^. break isSpace
cf10d6f1 836 return (go p'')
7ed76745 837 _unwords = PG.intercalates (yield $ T.singleton ' ')
0f8c6f1b 838
91727d11 839{-# INLINABLE words #-}
840
cf10d6f1 841
31f41a5d 842{-| 'intercalate' concatenates the 'FreeT'-delimited text streams after
843 interspersing a text stream in between them
91727d11 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
7ed76745 853 x <- lift (runFreeT f)
91727d11 854 case x of
7ed76745 855 Pure r -> return r
856 Free p -> do
91727d11 857 f' <- p
858 go1 f'
859 go1 f = do
7ed76745 860 x <- lift (runFreeT f)
91727d11 861 case x of
7ed76745 862 Pure r -> return r
863 Free p -> do
91727d11 864 p0
865 f' <- p
866 go1 f'
867{-# INLINABLE intercalate #-}
868
62e8521c 869{-| Join 'FreeT'-delimited lines into a text stream
91727d11 870-}
871unlines
872 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
873unlines = go
874 where
875 go f = do
7ed76745 876 x <- lift (runFreeT f)
91727d11 877 case x of
7ed76745 878 Pure r -> return r
879 Free p -> do
91727d11 880 f' <- p
881 yield $ T.singleton '\n'
882 go f'
883{-# INLINABLE unlines #-}
884
31f41a5d 885{-| Join 'FreeT'-delimited words into a text stream
91727d11 886-}
887unwords
888 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
7fc48f7c 889unwords = intercalate (yield $ T.singleton ' ')
91727d11 890{-# INLINABLE unwords #-}
891
91727d11 892
91727d11 893{- $reexports
91727d11 894
895 @Data.Text@ re-exports the 'Text' type.
896
0f8c6f1b 897 @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym.
64e03122 898-}
899
bbdfd305 900