Pipes/Text.hs

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