Pipes/Text.hs

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