]> git.immae.eu Git - github/fretlink/text-pipes.git/blame - Pipes/Text.hs
detritus
[github/fretlink/text-pipes.git] / Pipes / Text.hs
CommitLineData
e8336ba6 1{-# LANGUAGE RankNTypes, TypeFamilies, BangPatterns, Safe#-}
9667f797 2
955edd33 3{-| The module @Pipes.Text@ closely follows @Pipes.ByteString@ from
4 the @pipes-bytestring@ package. A draft tutorial can be found in
5 @Pipes.Text.Tutorial@.
6-}
2f4a83f8 7
955edd33 8module Pipes.Text (
91727d11 9 -- * Producers
1a83ae4e 10 fromLazy
91727d11 11
12 -- * Pipes
1677dc12 13 , map
14 , concatMap
15 , take
1677dc12 16 , takeWhile
1677dc12 17 , filter
1677dc12 18 , toCaseFold
19 , toLower
20 , toUpper
21 , stripStart
2f4a83f8 22 , scan
91727d11 23
24 -- * Folds
1677dc12 25 , toLazy
26 , toLazyM
27 , foldChars
28 , head
29 , last
30 , null
31 , length
32 , any
33 , all
34 , maximum
35 , minimum
36 , find
37 , index
1677dc12 38
39 -- * Primitive Character Parsers
1677dc12 40 , nextChar
41 , drawChar
42 , unDrawChar
43 , peekChar
9e9bb0ce 44 , isEndOfChars
1677dc12 45
2f4a83f8 46 -- * Parsing Lenses
9e9bb0ce 47 , splitAt
1677dc12 48 , span
49 , break
50 , groupBy
51 , group
9e9bb0ce 52 , word
53 , line
1677dc12 54
2f4a83f8 55 -- * Transforming Text and Character Streams
56 , drop
57 , dropWhile
58 , pack
59 , unpack
60 , intersperse
61
62 -- * FreeT Transformations
1677dc12 63 , chunksOf
64 , splitsWith
0f8c6f1b 65 , splits
1a83ae4e 66 , groupsBy
67 , groups
1677dc12 68 , lines
1677dc12 69 , unlines
2f4a83f8 70 , words
1677dc12 71 , unwords
2f4a83f8 72 , intercalate
9e9bb0ce 73
1a83ae4e 74 -- * Re-exports
91727d11 75 -- $reexports
1677dc12 76 , module Data.ByteString
77 , module Data.Text
1677dc12 78 , module Pipes.Parse
7ed76745 79 , module Pipes.Group
91727d11 80 ) where
81
70125641 82import Control.Monad (liftM, join)
e8336ba6 83import Control.Monad.Trans.State.Strict (modify)
91727d11 84import qualified Data.Text as T
91727d11 85import Data.Text (Text)
86import qualified Data.Text.Lazy as TL
31f41a5d 87import Data.ByteString (ByteString)
1677dc12 88import Data.Functor.Constant (Constant(Constant, getConstant))
91727d11 89import Data.Functor.Identity (Identity)
2f4a83f8 90
91727d11 91import Pipes
2f4a83f8 92import Pipes.Group (folds, maps, concats, intercalates, FreeT(..), FreeF(..))
7ed76745 93import qualified Pipes.Group as PG
91727d11 94import qualified Pipes.Parse as PP
7ed76745 95import Pipes.Parse (Parser)
91727d11 96import qualified Pipes.Prelude as P
91727d11 97import Data.Char (isSpace)
79917d53 98import Foreign.Storable (sizeOf)
99import Data.Bits (shiftL)
91727d11 100import Prelude hiding (
101 all,
102 any,
103 break,
104 concat,
105 concatMap,
106 drop,
107 dropWhile,
108 elem,
109 filter,
110 head,
111 last,
112 lines,
113 length,
114 map,
115 maximum,
116 minimum,
117 notElem,
118 null,
119 readFile,
120 span,
121 splitAt,
122 take,
123 takeWhile,
124 unlines,
125 unwords,
126 words,
127 writeFile )
128
e20590eb 129-- $setup
130-- >>> :set -XOverloadedStrings
131-- >>> import Data.Text (Text)
132-- >>> import qualified Data.Text as T
133-- >>> import qualified Data.Text.Lazy.IO as TL
134-- >>> import Data.Char
135
136-- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's. Producers in
137-- IO can be found in 'Pipes.Text.IO' or in pipes-bytestring, employed with the
138-- decoding lenses in 'Pipes.Text.Encoding'
91727d11 139fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
2f4a83f8 140fromLazy = TL.foldrChunks (\e a -> yield e >> a) (return ())
ca6f90a0 141{-# INLINE fromLazy #-}
91727d11 142
d199072b 143(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
144a ^. lens = getConstant (lens Constant a)
145
91727d11 146-- | Apply a transformation to each 'Char' in the stream
e20590eb 147
148-- >>> let margaret = ["Margaret, are you grieving\nOver Golde","ngrove unleaving?":: Text]
b28660f6 149-- >>> TL.putStrLn . toLazy $ each margaret >-> map Data.Char.toUpper
e20590eb 150-- MARGARET, ARE YOU GRIEVING
151-- OVER GOLDENGROVE UNLEAVING?
91727d11 152map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
153map f = P.map (T.map f)
154{-# INLINABLE map #-}
155
31f41a5d 156-- | Map a function over the characters of a text stream and concatenate the results
e20590eb 157
91727d11 158concatMap
159 :: (Monad m) => (Char -> Text) -> Pipe Text Text m r
160concatMap f = P.map (T.concatMap f)
161{-# INLINABLE concatMap #-}
162
2f4a83f8 163-- | @(take n)@ only allows @n@ individual characters to pass;
31f41a5d 164-- contrast @Pipes.Prelude.take@ which would let @n@ chunks pass.
91727d11 165take :: (Monad m, Integral a) => a -> Pipe Text Text m ()
166take n0 = go n0 where
167 go n
168 | n <= 0 = return ()
b28660f6 169 | otherwise = do
31f41a5d 170 txt <- await
171 let len = fromIntegral (T.length txt)
91727d11 172 if (len > n)
31f41a5d 173 then yield (T.take (fromIntegral n) txt)
91727d11 174 else do
31f41a5d 175 yield txt
91727d11 176 go (n - len)
177{-# INLINABLE take #-}
178
31f41a5d 179-- | Take characters until they fail the predicate
91727d11 180takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m ()
181takeWhile predicate = go
182 where
183 go = do
31f41a5d 184 txt <- await
185 let (prefix, suffix) = T.span predicate txt
91727d11 186 if (T.null suffix)
187 then do
31f41a5d 188 yield txt
91727d11 189 go
190 else yield prefix
191{-# INLINABLE takeWhile #-}
192
91727d11 193-- | Only allows 'Char's to pass if they satisfy the predicate
194filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
195filter predicate = P.map (T.filter predicate)
196{-# INLINABLE filter #-}
197
31f41a5d 198-- | Strict left scan over the characters
e20590eb 199-- >>> let margaret = ["Margaret, are you grieving\nOver Golde","ngrove unleaving?":: Text]
200-- >>> let title_caser a x = case a of ' ' -> Data.Char.toUpper x; _ -> x
201-- >>> toLazy $ each margaret >-> scan title_caser ' '
202-- " Margaret, Are You Grieving\nOver Goldengrove Unleaving?"
203
91727d11 204scan
205 :: (Monad m)
206 => (Char -> Char -> Char) -> Char -> Pipe Text Text m r
11645cdc
GG
207scan step begin = do
208 yield (T.singleton begin)
209 go begin
91727d11 210 where
31f41a5d 211 go c = do
212 txt <- await
213 let txt' = T.scanl step c txt
214 c' = T.last txt'
11645cdc 215 yield (T.tail txt')
31f41a5d 216 go c'
91727d11 217{-# INLINABLE scan #-}
218
2f4a83f8 219-- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities,
220-- here acting as 'Text' pipes, rather as they would on a lazy text
221toCaseFold :: Monad m => Pipe Text Text m r
222toCaseFold = P.map T.toCaseFold
223{-# INLINEABLE toCaseFold #-}
224
225-- | lowercase incoming 'Text'
226toLower :: Monad m => Pipe Text Text m r
227toLower = P.map T.toLower
228{-# INLINEABLE toLower #-}
229
230-- | uppercase incoming 'Text'
231toUpper :: Monad m => Pipe Text Text m r
232toUpper = P.map T.toUpper
233{-# INLINEABLE toUpper #-}
234
235-- | Remove leading white space from an incoming succession of 'Text's
236stripStart :: Monad m => Pipe Text Text m r
237stripStart = do
238 chunk <- await
239 let text = T.stripStart chunk
240 if T.null text
241 then stripStart
242 else do yield text
243 cat
244{-# INLINEABLE stripStart #-}
245
91727d11 246{-| Fold a pure 'Producer' of strict 'Text's into a lazy
247 'TL.Text'
248-}
249toLazy :: Producer Text Identity () -> TL.Text
250toLazy = TL.fromChunks . P.toList
251{-# INLINABLE toLazy #-}
252
253{-| Fold an effectful 'Producer' of strict 'Text's into a lazy
254 'TL.Text'
255
256 Note: 'toLazyM' is not an idiomatic use of @pipes@, but I provide it for
257 simple testing purposes. Idiomatic @pipes@ style consumes the chunks
258 immediately as they are generated instead of loading them all into memory.
259-}
260toLazyM :: (Monad m) => Producer Text m () -> m TL.Text
261toLazyM = liftM TL.fromChunks . P.toListM
262{-# INLINABLE toLazyM #-}
263
31f41a5d 264-- | Reduce the text stream using a strict left fold over characters
64e03122 265foldChars
91727d11 266 :: Monad m
267 => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r
64e03122 268foldChars step begin done = P.fold (T.foldl' step) begin done
1677dc12 269{-# INLINABLE foldChars #-}
91727d11 270
2f4a83f8 271
91727d11 272-- | Retrieve the first 'Char'
273head :: (Monad m) => Producer Text m () -> m (Maybe Char)
274head = go
275 where
276 go p = do
277 x <- nextChar p
278 case x of
279 Left _ -> return Nothing
31f41a5d 280 Right (c, _) -> return (Just c)
91727d11 281{-# INLINABLE head #-}
282
283-- | Retrieve the last 'Char'
284last :: (Monad m) => Producer Text m () -> m (Maybe Char)
285last = go Nothing
286 where
287 go r p = do
288 x <- next p
289 case x of
290 Left () -> return r
31f41a5d 291 Right (txt, p') ->
292 if (T.null txt)
91727d11 293 then go r p'
31f41a5d 294 else go (Just $ T.last txt) p'
91727d11 295{-# INLINABLE last #-}
296
297-- | Determine if the stream is empty
298null :: (Monad m) => Producer Text m () -> m Bool
299null = P.all T.null
300{-# INLINABLE null #-}
301
62e8521c 302-- | Count the number of characters in the stream
91727d11 303length :: (Monad m, Num n) => Producer Text m () -> m n
31f41a5d 304length = P.fold (\n txt -> n + fromIntegral (T.length txt)) 0 id
91727d11 305{-# INLINABLE length #-}
306
307-- | Fold that returns whether 'M.Any' received 'Char's satisfy the predicate
308any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
309any predicate = P.any (T.any predicate)
310{-# INLINABLE any #-}
311
312-- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate
313all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
314all predicate = P.all (T.all predicate)
315{-# INLINABLE all #-}
316
62e8521c 317-- | Return the maximum 'Char' within a text stream
91727d11 318maximum :: (Monad m) => Producer Text m () -> m (Maybe Char)
319maximum = P.fold step Nothing id
320 where
31f41a5d 321 step mc txt =
322 if (T.null txt)
323 then mc
324 else Just $ case mc of
325 Nothing -> T.maximum txt
326 Just c -> max c (T.maximum txt)
91727d11 327{-# INLINABLE maximum #-}
328
62e8521c 329-- | Return the minimum 'Char' within a text stream (surely very useful!)
91727d11 330minimum :: (Monad m) => Producer Text m () -> m (Maybe Char)
331minimum = P.fold step Nothing id
332 where
31f41a5d 333 step mc txt =
334 if (T.null txt)
335 then mc
336 else case mc of
337 Nothing -> Just (T.minimum txt)
338 Just c -> Just (min c (T.minimum txt))
91727d11 339{-# INLINABLE minimum #-}
340
91727d11 341-- | Find the first element in the stream that matches the predicate
342find
343 :: (Monad m)
344 => (Char -> Bool) -> Producer Text m () -> m (Maybe Char)
345find predicate p = head (p >-> filter predicate)
346{-# INLINABLE find #-}
347
62e8521c 348-- | Index into a text stream
91727d11 349index
350 :: (Monad m, Integral a)
351 => a-> Producer Text m () -> m (Maybe Char)
2f4a83f8 352index n p = head (drop n p)
91727d11 353{-# INLINABLE index #-}
354
63ea9ffd 355
9e9bb0ce 356
1a83ae4e 357-- | Consume the first character from a stream of 'Text'
2f4a83f8 358--
1a83ae4e 359-- 'next' either fails with a 'Left' if the 'Producer' has no more characters or
360-- succeeds with a 'Right' providing the next character and the remainder of the
361-- 'Producer'.
9e9bb0ce 362
9e9bb0ce 363nextChar
364 :: (Monad m)
365 => Producer Text m r
366 -> m (Either r (Char, Producer Text m r))
367nextChar = go
368 where
369 go p = do
370 x <- next p
371 case x of
372 Left r -> return (Left r)
373 Right (txt, p') -> case (T.uncons txt) of
374 Nothing -> go p'
375 Just (c, txt') -> return (Right (c, yield txt' >> p'))
376{-# INLINABLE nextChar #-}
377
1a83ae4e 378-- | Draw one 'Char' from a stream of 'Text', returning 'Left' if the 'Producer' is empty
379
9e9bb0ce 380drawChar :: (Monad m) => Parser Text m (Maybe Char)
381drawChar = do
382 x <- PP.draw
383 case x of
384 Nothing -> return Nothing
385 Just txt -> case (T.uncons txt) of
386 Nothing -> drawChar
387 Just (c, txt') -> do
388 PP.unDraw txt'
389 return (Just c)
390{-# INLINABLE drawChar #-}
391
392-- | Push back a 'Char' onto the underlying 'Producer'
393unDrawChar :: (Monad m) => Char -> Parser Text m ()
394unDrawChar c = modify (yield (T.singleton c) >>)
395{-# INLINABLE unDrawChar #-}
396
397{-| 'peekChar' checks the first 'Char' in the stream, but uses 'unDrawChar' to
398 push the 'Char' back
399
400> peekChar = do
401> x <- drawChar
402> case x of
403> Left _ -> return ()
404> Right c -> unDrawChar c
405> return x
1a83ae4e 406
9e9bb0ce 407-}
1a83ae4e 408
9e9bb0ce 409peekChar :: (Monad m) => Parser Text m (Maybe Char)
410peekChar = do
411 x <- drawChar
412 case x of
413 Nothing -> return ()
414 Just c -> unDrawChar c
415 return x
416{-# INLINABLE peekChar #-}
417
418{-| Check if the underlying 'Producer' has no more characters
419
420 Note that this will skip over empty 'Text' chunks, unlike
421 'PP.isEndOfInput' from @pipes-parse@, which would consider
422 an empty 'Text' a valid bit of input.
423
424> isEndOfChars = liftM isLeft peekChar
425-}
426isEndOfChars :: (Monad m) => Parser Text m Bool
427isEndOfChars = do
428 x <- peekChar
429 return (case x of
430 Nothing -> True
431 Just _-> False )
432{-# INLINABLE isEndOfChars #-}
433
31f41a5d 434-- | Splits a 'Producer' after the given number of characters
91727d11 435splitAt
436 :: (Monad m, Integral n)
437 => n
57454c33 438 -> Lens' (Producer Text m r)
d199072b 439 (Producer Text m (Producer Text m r))
9e9bb0ce 440splitAt n0 k p0 = fmap join (k (go n0 p0))
91727d11 441 where
442 go 0 p = return p
443 go n p = do
444 x <- lift (next p)
445 case x of
446 Left r -> return (return r)
31f41a5d 447 Right (txt, p') -> do
448 let len = fromIntegral (T.length txt)
91727d11 449 if (len <= n)
450 then do
31f41a5d 451 yield txt
91727d11 452 go (n - len) p'
453 else do
31f41a5d 454 let (prefix, suffix) = T.splitAt (fromIntegral n) txt
91727d11 455 yield prefix
456 return (yield suffix >> p')
457{-# INLINABLE splitAt #-}
458
91727d11 459
1a83ae4e 460-- | Split a text stream in two, producing the longest
461-- consecutive group of characters that satisfies the predicate
462-- and returning the rest
463
91727d11 464span
465 :: (Monad m)
466 => (Char -> Bool)
57454c33 467 -> Lens' (Producer Text m r)
d199072b 468 (Producer Text m (Producer Text m r))
9e9bb0ce 469span predicate k p0 = fmap join (k (go p0))
91727d11 470 where
471 go p = do
472 x <- lift (next p)
473 case x of
474 Left r -> return (return r)
31f41a5d 475 Right (txt, p') -> do
476 let (prefix, suffix) = T.span predicate txt
91727d11 477 if (T.null suffix)
478 then do
31f41a5d 479 yield txt
91727d11 480 go p'
481 else do
482 yield prefix
483 return (yield suffix >> p')
484{-# INLINABLE span #-}
485
1a83ae4e 486{-| Split a text stream in two, producing the longest
62e8521c 487 consecutive group of characters that don't satisfy the predicate
91727d11 488-}
489break
490 :: (Monad m)
491 => (Char -> Bool)
57454c33 492 -> Lens' (Producer Text m r)
d199072b 493 (Producer Text m (Producer Text m r))
91727d11 494break predicate = span (not . predicate)
495{-# INLINABLE break #-}
496
9e9bb0ce 497{-| Improper lens that splits after the first group of equivalent Chars, as
498 defined by the given equivalence relation
499-}
500groupBy
501 :: (Monad m)
502 => (Char -> Char -> Bool)
57454c33 503 -> Lens' (Producer Text m r)
d199072b 504 (Producer Text m (Producer Text m r))
9e9bb0ce 505groupBy equals k p0 = fmap join (k ((go p0))) where
506 go p = do
507 x <- lift (next p)
508 case x of
509 Left r -> return (return r)
510 Right (txt, p') -> case T.uncons txt of
511 Nothing -> go p'
2f4a83f8 512 Just (c, _) -> (yield txt >> p') ^. span (equals c)
9e9bb0ce 513{-# INLINABLE groupBy #-}
514
515-- | Improper lens that splits after the first succession of identical 'Char' s
2f4a83f8 516group :: Monad m
57454c33 517 => Lens' (Producer Text m r)
9e9bb0ce 518 (Producer Text m (Producer Text m r))
519group = groupBy (==)
520{-# INLINABLE group #-}
521
522{-| Improper lens that splits a 'Producer' after the first word
523
2f4a83f8 524 Unlike 'words', this does not drop leading whitespace
9e9bb0ce 525-}
2f4a83f8 526word :: (Monad m)
57454c33 527 => Lens' (Producer Text m r)
d199072b 528 (Producer Text m (Producer Text m r))
9e9bb0ce 529word k p0 = fmap join (k (to p0))
530 where
531 to p = do
532 p' <- p^.span isSpace
533 p'^.break isSpace
534{-# INLINABLE word #-}
535
2f4a83f8 536line :: (Monad m)
57454c33 537 => Lens' (Producer Text m r)
d199072b 538 (Producer Text m (Producer Text m r))
9e9bb0ce 539line = break (== '\n')
9e9bb0ce 540{-# INLINABLE line #-}
541
2f4a83f8 542-- | @(drop n)@ drops the first @n@ characters
543drop :: (Monad m, Integral n)
544 => n -> Producer Text m r -> Producer Text m r
545drop n p = do
546 p' <- lift $ runEffect (for (p ^. splitAt n) discard)
547 p'
548{-# INLINABLE drop #-}
549
550-- | Drop characters until they fail the predicate
551dropWhile :: (Monad m)
552 => (Char -> Bool) -> Producer Text m r -> Producer Text m r
553dropWhile predicate p = do
554 p' <- lift $ runEffect (for (p ^. span predicate) discard)
555 p'
556{-# INLINABLE dropWhile #-}
9e9bb0ce 557
558-- | Intersperse a 'Char' in between the characters of stream of 'Text'
559intersperse
560 :: (Monad m) => Char -> Producer Text m r -> Producer Text m r
561intersperse c = go0
562 where
563 go0 p = do
564 x <- lift (next p)
565 case x of
566 Left r -> return r
567 Right (txt, p') -> do
568 yield (T.intersperse c txt)
569 go1 p'
570 go1 p = do
571 x <- lift (next p)
572 case x of
573 Left r -> return r
574 Right (txt, p') -> do
575 yield (T.singleton c)
576 yield (T.intersperse c txt)
577 go1 p'
578{-# INLINABLE intersperse #-}
579
580
2f4a83f8 581-- | Improper lens from unpacked 'Word8's to packaged 'ByteString's
582pack :: Monad m => Lens' (Producer Char m r) (Producer Text m r)
583pack k p = fmap _unpack (k (_pack p))
584{-# INLINABLE pack #-}
585
586-- | Improper lens from packed 'ByteString's to unpacked 'Word8's
587unpack :: Monad m => Lens' (Producer Text m r) (Producer Char m r)
588unpack k p = fmap _pack (k (_unpack p))
589{-# INLINABLE unpack #-}
9e9bb0ce 590
2f4a83f8 591_pack :: Monad m => Producer Char m r -> Producer Text m r
592_pack p = folds step id done (p^.PG.chunksOf defaultChunkSize)
593 where
594 step diffAs w8 = diffAs . (w8:)
9e9bb0ce 595
596 done diffAs = T.pack (diffAs [])
2f4a83f8 597{-# INLINABLE _pack #-}
9e9bb0ce 598
2f4a83f8 599_unpack :: Monad m => Producer Text m r -> Producer Char m r
600_unpack p = for p (each . T.unpack)
601{-# INLINABLE _unpack #-}
9e9bb0ce 602
79917d53 603defaultChunkSize :: Int
604defaultChunkSize = 16384 - (sizeOf (undefined :: Int) `shiftL` 1)
0f8c6f1b 605
2f4a83f8 606
0f8c6f1b 607-- | Split a text stream into 'FreeT'-delimited text streams of fixed size
608chunksOf
609 :: (Monad m, Integral n)
2f4a83f8 610 => n -> Lens' (Producer Text m r)
d199072b 611 (FreeT (Producer Text m) m r)
0f8c6f1b 612chunksOf n k p0 = fmap concats (k (FreeT (go p0)))
613 where
614 go p = do
615 x <- next p
616 return $ case x of
7ed76745 617 Left r -> Pure r
618 Right (txt, p') -> Free $ do
2f4a83f8 619 p'' <- (yield txt >> p') ^. splitAt n
7ed76745 620 return $ FreeT (go p'')
0f8c6f1b 621{-# INLINABLE chunksOf #-}
622
623
62e8521c 624{-| Split a text stream into sub-streams delimited by characters that satisfy the
91727d11 625 predicate
626-}
1677dc12 627splitsWith
91727d11 628 :: (Monad m)
629 => (Char -> Bool)
2f4a83f8 630 -> Producer Text m r -> FreeT (Producer Text m) m r
7ed76745 631splitsWith predicate p0 = FreeT (go0 p0)
91727d11 632 where
633 go0 p = do
634 x <- next p
635 case x of
7ed76745 636 Left r -> return (Pure r)
31f41a5d 637 Right (txt, p') ->
638 if (T.null txt)
91727d11 639 then go0 p'
7ed76745 640 else return $ Free $ do
9e9bb0ce 641 p'' <- (yield txt >> p') ^. span (not . predicate)
7ed76745 642 return $ FreeT (go1 p'')
91727d11 643 go1 p = do
644 x <- nextChar p
645 return $ case x of
7ed76745 646 Left r -> Pure r
647 Right (_, p') -> Free $ do
2f4a83f8 648 p'' <- p' ^. span (not . predicate)
7ed76745 649 return $ FreeT (go1 p'')
1677dc12 650{-# INLINABLE splitsWith #-}
91727d11 651
31f41a5d 652-- | Split a text stream using the given 'Char' as the delimiter
0f8c6f1b 653splits :: (Monad m)
d199072b 654 => Char
57454c33 655 -> Lens' (Producer Text m r)
d199072b 656 (FreeT (Producer Text m) m r)
0f8c6f1b 657splits c k p =
2f4a83f8 658 fmap (intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p))
0f8c6f1b 659{-# INLINABLE splits #-}
660
661{-| Isomorphism between a stream of 'Text' and groups of equivalent 'Char's , using the
662 given equivalence relation
663-}
664groupsBy
665 :: Monad m
666 => (Char -> Char -> Bool)
57454c33 667 -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x)
2f4a83f8 668groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
0f8c6f1b 669 go p = do x <- next p
7ed76745 670 case x of Left r -> return (Pure r)
0f8c6f1b 671 Right (bs, p') -> case T.uncons bs of
672 Nothing -> go p'
7ed76745 673 Just (c, _) -> do return $ Free $ do
0f8c6f1b 674 p'' <- (yield bs >> p')^.span (equals c)
7ed76745 675 return $ FreeT (go p'')
0f8c6f1b 676{-# INLINABLE groupsBy #-}
677
678
679-- | Like 'groupsBy', where the equality predicate is ('==')
680groups
681 :: Monad m
57454c33 682 => Lens' (Producer Text m x) (FreeT (Producer Text m) m x)
0f8c6f1b 683groups = groupsBy (==)
684{-# INLINABLE groups #-}
685
91727d11 686
91727d11 687
62e8521c 688{-| Split a text stream into 'FreeT'-delimited lines
91727d11 689-}
690lines
2f4a83f8 691 :: (Monad m) => Lens' (Producer Text m r) (FreeT (Producer Text m) m r)
692lines k p = fmap _unlines (k (_lines p))
693{-# INLINABLE lines #-}
694
695unlines
696 :: Monad m
697 => Lens' (FreeT (Producer Text m) m r) (Producer Text m r)
698unlines k p = fmap _lines (k (_unlines p))
699{-# INLINABLE unlines #-}
700
701_lines :: Monad m
702 => Producer Text m r -> FreeT (Producer Text m) m r
703_lines p0 = FreeT (go0 p0)
0f8c6f1b 704 where
705 go0 p = do
706 x <- next p
707 case x of
7ed76745 708 Left r -> return (Pure r)
0f8c6f1b 709 Right (txt, p') ->
710 if (T.null txt)
711 then go0 p'
7ed76745 712 else return $ Free $ go1 (yield txt >> p')
0f8c6f1b 713 go1 p = do
714 p' <- p ^. break ('\n' ==)
7ed76745 715 return $ FreeT $ do
0f8c6f1b 716 x <- nextChar p'
717 case x of
7ed76745 718 Left r -> return $ Pure r
0f8c6f1b 719 Right (_, p'') -> go0 p''
2f4a83f8 720{-# INLINABLE _lines #-}
0f8c6f1b 721
2f4a83f8 722_unlines :: Monad m
723 => FreeT (Producer Text m) m r -> Producer Text m r
724_unlines = concats . maps (<* yield (T.singleton '\n'))
725{-# INLINABLE _unlines #-}
91727d11 726
2f4a83f8 727-- | Split a text stream into 'FreeT'-delimited words. Note that
728-- roundtripping with e.g. @over words id@ eliminates extra space
729-- characters as with @Prelude.unwords . Prelude.words@
91727d11 730words
2f4a83f8 731 :: (Monad m) => Lens' (Producer Text m r) (FreeT (Producer Text m) m r)
732words k p = fmap _unwords (k (_words p))
733{-# INLINABLE words #-}
734
735unwords
736 :: Monad m
737 => Lens' (FreeT (Producer Text m) m r) (Producer Text m r)
738unwords k p = fmap _words (k (_unwords p))
739{-# INLINABLE unwords #-}
740
741_words :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
742_words p = FreeT $ do
743 x <- next (dropWhile isSpace p)
cf10d6f1 744 return $ case x of
7ed76745 745 Left r -> Pure r
746 Right (bs, p') -> Free $ do
9e9bb0ce 747 p'' <- (yield bs >> p') ^. break isSpace
2f4a83f8 748 return (_words p'')
749{-# INLINABLE _words #-}
750
751_unwords :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
752_unwords = intercalates (yield $ T.singleton ' ')
753{-# INLINABLE _unwords #-}
91727d11 754
cf10d6f1 755
31f41a5d 756{-| 'intercalate' concatenates the 'FreeT'-delimited text streams after
757 interspersing a text stream in between them
91727d11 758-}
759intercalate
760 :: (Monad m)
2f4a83f8 761 => Producer Text m () -> FreeT (Producer Text m) m r -> Producer Text m r
91727d11 762intercalate p0 = go0
763 where
764 go0 f = do
7ed76745 765 x <- lift (runFreeT f)
91727d11 766 case x of
7ed76745 767 Pure r -> return r
768 Free p -> do
91727d11 769 f' <- p
770 go1 f'
771 go1 f = do
7ed76745 772 x <- lift (runFreeT f)
91727d11 773 case x of
7ed76745 774 Pure r -> return r
775 Free p -> do
91727d11 776 p0
777 f' <- p
778 go1 f'
779{-# INLINABLE intercalate #-}
780
91727d11 781
91727d11 782
91727d11 783{- $reexports
2f4a83f8 784
91727d11 785 @Data.Text@ re-exports the 'Text' type.
786
2f4a83f8 787 @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym.
64e03122 788-}
789
bbdfd305 790
5e387e52 791type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)