Pipes/Text.hs

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