Pipes/Text.hs

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