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