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