Pipes/Text.hs

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