Pipes/Text.hs

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