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