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 {-# RULES "p >-> toHandle h" forall p h .
 309         p >-> toHandle h = for p (\bs -> liftIO (T.hPutStr h bs))
 310   #-}
 311
 312
 313 -- | Stream text into a file. Uses @pipes-safe@.
 314 writeFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Consumer' Text m ()
 315 writeFile file = Safe.withFile file IO.WriteMode toHandle
 316
 317 -- | Apply a transformation to each 'Char' in the stream
 318 map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
 319 map f = P.map (T.map f)
 320 {-# INLINABLE map #-}
 321
 322 -- | Map a function over the characters of a text stream and concatenate the results
 323 concatMap
 324     :: (Monad m) => (Char -> Text) -> Pipe Text Text m r
 325 concatMap f = P.map (T.concatMap f)
 326 {-# INLINABLE concatMap #-}
 327
 328
 329 -- | Transform a Pipe of 'Text' into a Pipe of 'ByteString's using UTF-8
 330 -- encoding; @encodeUtf8 = Pipes.Prelude.map TE.encodeUtf8@ so more complex
 331 -- encoding pipes can easily be constructed with the functions in @Data.Text.Encoding@
 332 encodeUtf8 :: Monad m => Pipe Text ByteString m r
 333 encodeUtf8 = P.map TE.encodeUtf8
 334 {-# INLINEABLE encodeUtf8 #-}
 335
 336 -- | Transform a Pipe of 'String's into one of 'Text' chunks
 337 pack :: Monad m => Pipe String Text m r
 338 pack = P.map T.pack
 339 {-# INLINEABLE pack #-}
 340
 341 -- | Transforma a Pipes of 'Text' chunks into one of 'String's
 342 unpack :: Monad m => Pipe Text String m r
 343 unpack = for cat (\t -> yield (T.unpack t))
 344 {-# INLINEABLE unpack #-}
 345
 346
 347 -- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utility,
 348 -- here acting on a 'Text' pipe, rather as they would  on a lazy text
 349 toCaseFold :: Monad m => Pipe Text Text m ()
 350 toCaseFold = P.map T.toCaseFold
 351 {-# INLINEABLE toCaseFold #-}
 352
 353 -- | lowercase incoming 'Text'
 354 toLower :: Monad m => Pipe Text Text m ()
 355 toLower = P.map T.toLower
 356 {-# INLINEABLE toLower #-}
 357
 358 -- | uppercase incoming 'Text'
 359 toUpper :: Monad m => Pipe Text Text m ()
 360 toUpper = P.map T.toUpper
 361 {-# INLINEABLE toUpper #-}
 362
 363 -- | Remove leading white space from an incoming succession of 'Text's
 364 stripStart :: Monad m => Pipe Text Text m r
 365 stripStart = do
 366     chunk <- await
 367     let text = T.stripStart chunk
 368     if T.null text
 369       then stripStart
 370       else cat
 371 {-# INLINEABLE stripStart #-}
 372
 373 -- | @(take n)@ only allows @n@ individual characters to pass;
 374 --  contrast @Pipes.Prelude.take@ which would let @n@ chunks pass.
 375 take :: (Monad m, Integral a) => a -> Pipe Text Text m ()
 376 take n0 = go n0 where
 377     go n
 378         | n <= 0    = return ()
 379         | otherwise = do
 380             txt <- await
 381             let len = fromIntegral (T.length txt)
 382             if (len > n)
 383                 then yield (T.take (fromIntegral n) txt)
 384                 else do
 385                     yield txt
 386                     go (n - len)
 387 {-# INLINABLE take #-}
 388
 389 -- | @(drop n)@ drops the first @n@ characters
 390 drop :: (Monad m, Integral a) => a -> Pipe Text Text m r
 391 drop n0 = go n0 where
 392     go n
 393         | n <= 0    = cat
 394         | otherwise = do
 395             txt <- await
 396             let len = fromIntegral (T.length txt)
 397             if (len >= n)
 398                 then do
 399                     yield (T.drop (fromIntegral n) txt)
 400                     cat
 401                 else go (n - len)
 402 {-# INLINABLE drop #-}
 403
 404 -- | Take characters until they fail the predicate
 405 takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m ()
 406 takeWhile predicate = go
 407   where
 408     go = do
 409         txt <- await
 410         let (prefix, suffix) = T.span predicate txt
 411         if (T.null suffix)
 412             then do
 413                 yield txt
 414                 go
 415             else yield prefix
 416 {-# INLINABLE takeWhile #-}
 417
 418 -- | Drop characters until they fail the predicate
 419 dropWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
 420 dropWhile predicate = go where
 421     go = do
 422         txt <- await
 423         case T.findIndex (not . predicate) txt of
 424             Nothing -> go
 425             Just i -> do
 426                 yield (T.drop i txt)
 427                 cat
 428 {-# INLINABLE dropWhile #-}
 429
 430 -- | Only allows 'Char's to pass if they satisfy the predicate
 431 filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
 432 filter predicate = P.map (T.filter predicate)
 433 {-# INLINABLE filter #-}
 434
 435
 436 -- | Strict left scan over the characters
 437 scan
 438     :: (Monad m)
 439     => (Char -> Char -> Char) -> Char -> Pipe Text Text m r
 440 scan step begin = go begin
 441   where
 442     go c = do
 443         txt <- await
 444         let txt' = T.scanl step c txt
 445             c' = T.last txt'
 446         yield txt'
 447         go c'
 448 {-# INLINABLE scan #-}
 449
 450 {-| Fold a pure 'Producer' of strict 'Text's into a lazy
 451     'TL.Text'
 452 -}
 453 toLazy :: Producer Text Identity () -> TL.Text
 454 toLazy = TL.fromChunks . P.toList
 455 {-# INLINABLE toLazy #-}
 456
 457 {-| Fold an effectful 'Producer' of strict 'Text's into a lazy
 458     'TL.Text'
 459
 460     Note: 'toLazyM' is not an idiomatic use of @pipes@, but I provide it for
 461     simple testing purposes.  Idiomatic @pipes@ style consumes the chunks
 462     immediately as they are generated instead of loading them all into memory.
 463 -}
 464 toLazyM :: (Monad m) => Producer Text m () -> m TL.Text
 465 toLazyM = liftM TL.fromChunks . P.toListM
 466 {-# INLINABLE toLazyM #-}
 467
 468 -- | Reduce the text stream using a strict left fold over characters
 469 fold
 470     :: Monad m
 471     => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r
 472 fold step begin done = P.fold (T.foldl' step) begin done
 473 {-# INLINABLE fold #-}
 474
 475 -- | Retrieve the first 'Char'
 476 head :: (Monad m) => Producer Text m () -> m (Maybe Char)
 477 head = go
 478   where
 479     go p = do
 480         x <- nextChar p
 481         case x of
 482             Left   _      -> return  Nothing
 483             Right (c, _) -> return (Just c)
 484 {-# INLINABLE head #-}
 485
 486 -- | Retrieve the last 'Char'
 487 last :: (Monad m) => Producer Text m () -> m (Maybe Char)
 488 last = go Nothing
 489   where
 490     go r p = do
 491         x <- next p
 492         case x of
 493             Left   ()      -> return r
 494             Right (txt, p') ->
 495                 if (T.null txt)
 496                 then go r p'
 497                 else go (Just $ T.last txt) p'
 498 {-# INLINABLE last #-}
 499
 500 -- | Determine if the stream is empty
 501 null :: (Monad m) => Producer Text m () -> m Bool
 502 null = P.all T.null
 503 {-# INLINABLE null #-}
 504
 505 -- | Count the number of characters in the stream
 506 length :: (Monad m, Num n) => Producer Text m () -> m n
 507 length = P.fold (\n txt -> n + fromIntegral (T.length txt)) 0 id
 508 {-# INLINABLE length #-}
 509
 510 -- | Fold that returns whether 'M.Any' received 'Char's satisfy the predicate
 511 any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
 512 any predicate = P.any (T.any predicate)
 513 {-# INLINABLE any #-}
 514
 515 -- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate
 516 all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
 517 all predicate = P.all (T.all predicate)
 518 {-# INLINABLE all #-}
 519
 520 -- | Return the maximum 'Char' within a text stream
 521 maximum :: (Monad m) => Producer Text m () -> m (Maybe Char)
 522 maximum = P.fold step Nothing id
 523   where
 524     step mc txt =
 525         if (T.null txt)
 526         then mc
 527         else Just $ case mc of
 528             Nothing -> T.maximum txt
 529             Just c -> max c (T.maximum txt)
 530 {-# INLINABLE maximum #-}
 531
 532 -- | Return the minimum 'Char' within a text stream (surely very useful!)
 533 minimum :: (Monad m) => Producer Text m () -> m (Maybe Char)
 534 minimum = P.fold step Nothing id
 535   where
 536     step mc txt =
 537         if (T.null txt)
 538         then mc
 539         else case mc of
 540             Nothing -> Just (T.minimum txt)
 541             Just c -> Just (min c (T.minimum txt))
 542 {-# INLINABLE minimum #-}
 543
 544 -- | Find the first element in the stream that matches the predicate
 545 find
 546     :: (Monad m)
 547     => (Char -> Bool) -> Producer Text m () -> m (Maybe Char)
 548 find predicate p = head (p >-> filter predicate)
 549 {-# INLINABLE find #-}
 550
 551 -- | Index into a text stream
 552 index
 553     :: (Monad m, Integral a)
 554     => a-> Producer Text m () -> m (Maybe Char)
 555 index n p = head (p >-> drop n)
 556 {-# INLINABLE index #-}
 557
 558
 559 -- | Store a tally of how many segments match the given 'Text'
 560 count :: (Monad m, Num n) => Text -> Producer Text m () -> m n
 561 count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c))
 562 {-# INLINABLE count #-}
 563
 564 #if MIN_VERSION_text(0,11,4)
 565 -- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded
 566 -- into a Pipe of Text
 567 decodeUtf8
 568   :: Monad m
 569   => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
 570 decodeUtf8 = go TE.streamDecodeUtf8
 571   where go dec p = do
 572             x <- lift (next p)
 573             case x of
 574                 Left r -> return (return r)
 575                 Right (chunk, p') -> do
 576                     let TE.Some text l dec' = dec chunk
 577                     if B.null l
 578                       then do
 579                           yield text
 580                           go dec' p'
 581                       else return $ do
 582                           yield l
 583                           p'
 584 {-# INLINEABLE decodeUtf8 #-}
 585
 586 -- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded
 587 -- into a Pipe of Text with a replacement function of type @String -> Maybe Word8 -> Maybe Char@
 588 -- E.g. 'Data.Text.Encoding.Error.lenientDecode', which simply replaces bad bytes with \"�\"
 589 decodeUtf8With
 590   :: Monad m
 591   => TE.OnDecodeError
 592   -> Producer ByteString m r -> Producer Text m (Producer ByteString m r)
 593 decodeUtf8With onErr = go (TE.streamDecodeUtf8With onErr)
 594   where go dec p = do
 595             x <- lift (next p)
 596             case x of
 597                 Left r -> return (return r)
 598                 Right (chunk, p') -> do
 599                     let TE.Some text l dec' = dec chunk
 600                     if B.null l
 601                       then do
 602                           yield text
 603                           go dec' p'
 604                       else return $ do
 605                           yield l
 606                           p'
 607 {-# INLINEABLE decodeUtf8With #-}
 608
 609 -- | A simple pipe from 'ByteString' to 'Text'; a decoding error will arise
 610 -- with any chunk that contains a sequence of bytes that is unreadable. Otherwise
 611 -- only few bytes will only be moved from one chunk to the next before decoding.
 612 pipeDecodeUtf8 :: Monad m => Pipe ByteString Text m r
 613 pipeDecodeUtf8 = go TE.streamDecodeUtf8
 614   where go dec = do chunk <- await
 615                     case dec chunk of
 616                       TE.Some text l dec' -> do yield text
 617                                                 go dec'
 618 {-# INLINEABLE pipeDecodeUtf8 #-}
 619
 620 -- | A simple pipe from 'ByteString' to 'Text' using a replacement function.
 621 pipeDecodeUtf8With
 622   :: Monad m
 623   => TE.OnDecodeError
 624   -> Pipe ByteString Text m r
 625 pipeDecodeUtf8With onErr = go (TE.streamDecodeUtf8With onErr)
 626   where go dec = do chunk <- await
 627                     case dec chunk of
 628                       TE.Some text l dec' -> do yield text
 629                                                 go dec'
 630 {-# INLINEABLE pipeDecodeUtf8With #-}
 631 #endif
 632
 633 -- | Splits a 'Producer' after the given number of characters
 634 splitAt
 635     :: (Monad m, Integral n)
 636     => n
 637     -> Producer Text m r
 638     -> Producer' Text m (Producer Text m r)
 639 splitAt = go
 640   where
 641     go 0 p = return p
 642     go n p = do
 643         x <- lift (next p)
 644         case x of
 645             Left   r       -> return (return r)
 646             Right (txt, p') -> do
 647                 let len = fromIntegral (T.length txt)
 648                 if (len <= n)
 649                     then do
 650                         yield txt
 651                         go (n - len) p'
 652                     else do
 653                         let (prefix, suffix) = T.splitAt (fromIntegral n) txt
 654                         yield prefix
 655                         return (yield suffix >> p')
 656 {-# INLINABLE splitAt #-}
 657
 658 -- | Split a text stream into 'FreeT'-delimited text streams of fixed size
 659 chunksOf
 660     :: (Monad m, Integral n)
 661     => n -> Producer Text m r -> FreeT (Producer Text m) m r
 662 chunksOf n p0 = PP.FreeT (go p0)
 663   where
 664     go p = do
 665         x <- next p
 666         return $ case x of
 667             Left   r       -> PP.Pure r
 668             Right (txt, p') -> PP.Free $ do
 669                 p'' <- splitAt n (yield txt >> p')
 670                 return $ PP.FreeT (go p'')
 671 {-# INLINABLE chunksOf #-}
 672
 673 {-| Split a text stream in two, where the first text stream is the longest
 674     consecutive group of text that satisfy the predicate
 675 -}
 676 span
 677     :: (Monad m)
 678     => (Char -> Bool)
 679     -> Producer Text m r
 680     -> Producer' Text m (Producer Text m r)
 681 span predicate = go
 682   where
 683     go p = do
 684         x <- lift (next p)
 685         case x of
 686             Left   r       -> return (return r)
 687             Right (txt, p') -> do
 688                 let (prefix, suffix) = T.span predicate txt
 689                 if (T.null suffix)
 690                     then do
 691                         yield txt
 692                         go p'
 693                     else do
 694                         yield prefix
 695                         return (yield suffix >> p')
 696 {-# INLINABLE span #-}
 697
 698 {-| Split a text stream in two, where the first text stream is the longest
 699     consecutive group of characters that don't satisfy the predicate
 700 -}
 701 break
 702     :: (Monad m)
 703     => (Char -> Bool)
 704     -> Producer Text m r
 705     -> Producer Text m (Producer Text m r)
 706 break predicate = span (not . predicate)
 707 {-# INLINABLE break #-}
 708
 709 {-| Split a text stream into sub-streams delimited by characters that satisfy the
 710     predicate
 711 -}
 712 splitWith
 713     :: (Monad m)
 714     => (Char -> Bool)
 715     -> Producer Text m r
 716     -> PP.FreeT (Producer Text m) m r
 717 splitWith predicate p0 = PP.FreeT (go0 p0)
 718   where
 719     go0 p = do
 720         x <- next p
 721         case x of
 722             Left   r       -> return (PP.Pure r)
 723             Right (txt, p') ->
 724                 if (T.null txt)
 725                 then go0 p'
 726                 else return $ PP.Free $ do
 727                     p'' <- span (not . predicate) (yield txt >> p')
 728                     return $ PP.FreeT (go1 p'')
 729     go1 p = do
 730         x <- nextChar p
 731         return $ case x of
 732             Left   r      -> PP.Pure r
 733             Right (_, p') -> PP.Free $ do
 734                     p'' <- span (not . predicate) p'
 735                     return $ PP.FreeT (go1 p'')
 736 {-# INLINABLE splitWith #-}
 737
 738 -- | Split a text stream using the given 'Char' as the delimiter
 739 split :: (Monad m)
 740       => Char
 741       -> Producer Text m r
 742       -> FreeT (Producer Text m) m r
 743 split c = splitWith (c ==)
 744 {-# INLINABLE split #-}
 745
 746 {-| Group a text stream into 'FreeT'-delimited text streams using the supplied
 747     equality predicate
 748 -}
 749 groupBy
 750     :: (Monad m)
 751     => (Char -> Char -> Bool)
 752     -> Producer Text m r
 753     -> FreeT (Producer Text m) m r
 754 groupBy equal p0 = PP.FreeT (go p0)
 755   where
 756     go p = do
 757         x <- next p
 758         case x of
 759             Left   r       -> return (PP.Pure r)
 760             Right (txt, p') -> case (T.uncons txt) of
 761                 Nothing      -> go p'
 762                 Just (c, _) -> do
 763                     return $ PP.Free $ do
 764                         p'' <- span (equal c) (yield txt >> p')
 765                         return $ PP.FreeT (go p'')
 766 {-# INLINABLE groupBy #-}
 767
 768 -- | Group a text stream into 'FreeT'-delimited text streams of identical characters
 769 group
 770     :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
 771 group = groupBy (==)
 772 {-# INLINABLE group #-}
 773
 774 {-| Split a text stream into 'FreeT'-delimited lines
 775 -}
 776 lines
 777     :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
 778 lines p0 = PP.FreeT (go0 p0)
 779   where
 780     go0 p = do
 781         x <- next p
 782         case x of
 783             Left   r       -> return (PP.Pure r)
 784             Right (txt, p') ->
 785                 if (T.null txt)
 786                 then go0 p'
 787                 else return $ PP.Free $ go1 (yield txt >> p')
 788     go1 p = do
 789         p' <- break ('\n' ==) p
 790         return $ PP.FreeT $ do
 791             x  <- nextChar p'
 792             case x of
 793                 Left   r      -> return $ PP.Pure r
 794                 Right (_, p'') -> go0 p''
 795 {-# INLINABLE lines #-}
 796
 797
 798
 799 -- | Split a text stream into 'FreeT'-delimited words
 800 words
 801     :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
 802 words = go
 803   where
 804     go p = PP.FreeT $ do
 805         x <- next (p >-> dropWhile isSpace)
 806         return $ case x of
 807             Left   r       -> PP.Pure r
 808             Right (bs, p') -> PP.Free $ do
 809                 p'' <- break isSpace (yield bs >> p')
 810                 return (go p'')
 811 {-# INLINABLE words #-}
 812
 813
 814 -- | Intersperse a 'Char' in between the characters of the text stream
 815 intersperse
 816     :: (Monad m) => Char -> Producer Text m r -> Producer Text m r
 817 intersperse c = go0
 818   where
 819     go0 p = do
 820         x <- lift (next p)
 821         case x of
 822             Left   r       -> return r
 823             Right (txt, p') -> do
 824                 yield (T.intersperse c txt)
 825                 go1 p'
 826     go1 p = do
 827         x <- lift (next p)
 828         case x of
 829             Left   r       -> return r
 830             Right (txt, p') -> do
 831                 yield (T.singleton c)
 832                 yield (T.intersperse c txt)
 833                 go1 p'
 834 {-# INLINABLE intersperse #-}
 835
 836 {-| 'intercalate' concatenates the 'FreeT'-delimited text streams after
 837     interspersing a text stream in between them
 838 -}
 839 intercalate
 840     :: (Monad m)
 841     => Producer Text m ()
 842     -> FreeT (Producer Text m) m r
 843     -> Producer Text m r
 844 intercalate p0 = go0
 845   where
 846     go0 f = do
 847         x <- lift (PP.runFreeT f)
 848         case x of
 849             PP.Pure r -> return r
 850             PP.Free p -> do
 851                 f' <- p
 852                 go1 f'
 853     go1 f = do
 854         x <- lift (PP.runFreeT f)
 855         case x of
 856             PP.Pure r -> return r
 857             PP.Free p -> do
 858                 p0
 859                 f' <- p
 860                 go1 f'
 861 {-# INLINABLE intercalate #-}
 862
 863 {-| Join 'FreeT'-delimited lines into a text stream
 864 -}
 865 unlines
 866     :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
 867 unlines = go
 868   where
 869     go f = do
 870         x <- lift (PP.runFreeT f)
 871         case x of
 872             PP.Pure r -> return r
 873             PP.Free p -> do
 874                 f' <- p
 875                 yield $ T.singleton '\n'
 876                 go f'
 877 {-# INLINABLE unlines #-}
 878
 879 {-| Join 'FreeT'-delimited words into a text stream
 880 -}
 881 unwords
 882     :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
 883 unwords = intercalate (yield $ T.pack " ")
 884 {-# INLINABLE unwords #-}
 885
 886 {- $parse
 887     The following parsing utilities are single-character analogs of the ones found
 888     @pipes-parse@.
 889 -}
 890
 891 {- $reexports
 892     @Pipes.Text.Parse@ re-exports 'nextChar', 'drawChar', 'unDrawChar', 'peekChar', and 'isEndOfChars'.
 893
 894     @Data.Text@ re-exports the 'Text' type.
 895
 896     @Pipes.Parse@ re-exports 'input', 'concat', and 'FreeT' (the type).
 897 -}