Pipes/Text.hs

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