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