Pipes/Text.hs

   1 {-# LANGUAGE RankNTypes, TypeFamilies, BangPatterns, CPP #-}
   2 #if __GLASGOW_HASKELL__ >= 702
   3 {-# LANGUAGE Trustworthy #-}
   4 #endif
   5 {-| This module provides @pipes@ utilities for \"text streams\", which are
   6     streams of 'Text' chunks. The individual chunks are uniformly @strict@, but
   7     a 'Producer' can be converted to and from lazy 'Text's, though this is generally
   8     unwise.  Where pipes IO replaces lazy IO, 'Producer Text m r' replaces lazy 'Text'.
   9     An 'IO.Handle' can be associated with a 'Producer' or 'Consumer' according as it is read or written to.
  10
  11     To stream to or from 'IO.Handle's, one can use 'fromHandle' or 'toHandle'.  For
  12     example, the following program copies a document from one file to another:
  13
  14 > import Pipes
  15 > import qualified Data.Text.Pipes as Text
  16 > import System.IO
  17 >
  18 > main =
  19 >     withFile "inFile.txt"  ReadMode  $ \hIn  ->
  20 >     withFile "outFile.txt" WriteMode $ \hOut ->
  21 >     runEffect $ Text.fromHandle hIn >-> Text.toHandle hOut
  22
  23 To stream from files, the following is perhaps more Prelude-like (note that it uses Pipes.Safe):
  24
  25 > import Pipes
  26 > import qualified Data.Text.Pipes as Text
  27 > import Pipes.Safe
  28 >
  29 > main = runSafeT $ runEffect $ Text.readFile "inFile.txt" >-> Text.writeFile "outFile.txt"
  30
  31     You can stream to and from 'stdin' and 'stdout' using the predefined 'stdin'
  32     and 'stdout' pipes, as with the following \"echo\" program:
  33
  34 > main = runEffect $ Text.stdin >-> Text.stdout
  35
  36     You can also translate pure lazy 'TL.Text's to and from pipes:
  37
  38 > main = runEffect $ Text.fromLazy (TL.pack "Hello, world!\n") >-> Text.stdout
  39
  40     In addition, this module provides many functions equivalent to lazy
  41     'Text' functions so that you can transform or fold text streams.  For
  42     example, to stream only the first three lines of 'stdin' to 'stdout' you
  43     might write:
  44
  45 > import Pipes
  46 > import qualified Pipes.Text as Text
  47 > import qualified Pipes.Parse as Parse
  48 >
  49 > main = runEffect $ takeLines 3 Text.stdin >-> Text.stdout
  50 >   where
  51 >     takeLines n = Text.unlines . Parse.takeFree n . Text.lines
  52
  53     The above program will never bring more than one chunk of text (~ 32 KB) into
  54     memory, no matter how long the lines are.
  55
  56     Note that functions in this library are designed to operate on streams that
  57     are insensitive to text boundaries.  This means that they may freely split
  58     text into smaller texts, /discard empty texts/.  However, apart from the
  59     special case of 'concatMap', they will /never concatenate texts/ in order
  60     to provide strict upper bounds on memory usage -- with the single exception of 'concatMap'.
  61 -}
  62
  63 module Pipes.Text  (
  64     -- * Producers
  65       fromLazy
  66     , stdin
  67     , fromHandle
  68     , readFile
  69
  70     -- * Consumers
  71     , stdout
  72     , toHandle
  73     , writeFile
  74
  75     -- * Pipes
  76     , map
  77     , concatMap
  78     , take
  79     , drop
  80     , takeWhile
  81     , dropWhile
  82     , filter
  83     , scan
  84     , encodeUtf8
  85     , pack
  86     , unpack
  87     , toCaseFold
  88     , toLower
  89     , toUpper
  90     , stripStart
  91
  92     -- * Folds
  93     , toLazy
  94     , toLazyM
  95     , foldChars
  96     , head
  97     , last
  98     , null
  99     , length
 100     , any
 101     , all
 102     , maximum
 103     , minimum
 104     , find
 105     , index
 106     , count
 107
 108     -- * Primitive Character Parsers
 109     -- $parse
 110     , nextChar
 111     , drawChar
 112     , unDrawChar
 113     , peekChar
 114     , isEndOfChars
 115
 116     -- * Parsing Lenses
 117     , splitAt
 118     , span
 119     , break
 120     , groupBy
 121     , group
 122     , word
 123     , line
 124
 125     -- * Decoding Lenses
 126     , decodeUtf8
 127     , codec
 128
 129     -- * Codecs
 130     , utf8
 131     , utf16_le
 132     , utf16_be
 133     , utf32_le
 134     , utf32_be
 135
 136     -- * Other Decoding/Encoding Functions
 137     , decodeIso8859_1
 138     , decodeAscii
 139     , encodeIso8859_1
 140     , encodeAscii
 141
 142     -- * FreeT Splitters
 143     , chunksOf
 144     , splitsWith
 145     , splits
 146 --  , groupsBy
 147 --  , groups
 148     , lines
 149     , words
 150
 151     -- * Transformations
 152     , intersperse
 153     , packChars
 154
 155     -- * Joiners
 156     , intercalate
 157     , unlines
 158     , unwords
 159
 160    -- * Re-exports
 161     -- $reexports
 162     , Decoding(..)
 163     , streamDecodeUtf8
 164     , decodeSomeUtf8
 165     , Codec(..)
 166     , TextException(..)
 167     , module Data.ByteString
 168     , module Data.Text
 169     , module Data.Profunctor
 170     , module Data.Word
 171     , module Pipes.Parse
 172     , module Pipes.Group
 173     ) where
 174
 175 import Control.Exception (throwIO, try)
 176 import Control.Applicative ((<*))
 177 import Control.Monad (liftM, unless, join)
 178 import Control.Monad.Trans.State.Strict (StateT(..), modify)
 179 import Data.Monoid ((<>))
 180 import qualified Data.Text as T
 181 import qualified Data.Text.IO as T
 182 import qualified Data.Text.Encoding as TE
 183 import qualified Data.Text.Encoding.Error as TE
 184 import Data.Text (Text)
 185 import qualified Data.Text.Lazy as TL
 186 import qualified Data.Text.Lazy.IO as TL
 187 import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize)
 188 import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)
 189 import Data.ByteString (ByteString)
 190 import qualified Data.ByteString as B
 191 import qualified Data.ByteString.Char8 as B8
 192 import Data.Char (ord, isSpace)
 193 import Data.Functor.Constant (Constant(Constant, getConstant))
 194 import Data.Functor.Identity (Identity)
 195 import Data.Profunctor (Profunctor)
 196 import qualified Data.Profunctor
 197 import qualified Data.List as List
 198 import Foreign.C.Error (Errno(Errno), ePIPE)
 199 import qualified GHC.IO.Exception as G
 200 import Pipes
 201 import qualified Pipes.ByteString as PB
 202 import qualified Pipes.Text.Internal as PI
 203 import Pipes.Text.Internal
 204 import Pipes.Core (respond, Server')
 205 import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..))
 206 import qualified Pipes.Group as PG
 207 import qualified Pipes.Parse as PP
 208 import Pipes.Parse (Parser)
 209 import qualified Pipes.Safe.Prelude as Safe
 210 import qualified Pipes.Safe as Safe
 211 import Pipes.Safe (MonadSafe(..), Base(..))
 212 import qualified Pipes.Prelude as P
 213 import qualified System.IO as IO
 214 import Data.Char (isSpace)
 215 import Data.Word (Word8)
 216
 217 import Prelude hiding (
 218     all,
 219     any,
 220     break,
 221     concat,
 222     concatMap,
 223     drop,
 224     dropWhile,
 225     elem,
 226     filter,
 227     head,
 228     last,
 229     lines,
 230     length,
 231     map,
 232     maximum,
 233     minimum,
 234     notElem,
 235     null,
 236     readFile,
 237     span,
 238     splitAt,
 239     take,
 240     takeWhile,
 241     unlines,
 242     unwords,
 243     words,
 244     writeFile )
 245
 246 -- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's
 247 fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
 248 fromLazy  = foldrChunks (\e a -> yield e >> a) (return ())
 249 {-# INLINE fromLazy #-}
 250
 251 -- | Stream text from 'stdin'
 252 stdin :: MonadIO m => Producer Text m ()
 253 stdin = fromHandle IO.stdin
 254 {-# INLINE stdin #-}
 255
 256 {-| Convert a 'IO.Handle' into a text stream using a text size
 257     determined by the good sense of the text library; note that this
 258     is distinctly slower than @decideUtf8 (Pipes.ByteString.fromHandle h)@
 259     but uses the system encoding and has other `Data.Text.IO` features
 260 -}
 261
 262 fromHandle :: MonadIO m => IO.Handle -> Producer Text m ()
 263 fromHandle h =  go where
 264       go = do txt <- liftIO (T.hGetChunk h)
 265               unless (T.null txt) ( do yield txt
 266                                        go )
 267 {-# INLINABLE fromHandle#-}
 268
 269
 270 {-| Stream text from a file in the simple fashion of @Data.Text.IO@
 271
 272 >>> runSafeT $ runEffect $ Text.readFile "hello.hs" >-> Text.map toUpper >-> hoist lift Text.stdout
 273 MAIN = PUTSTRLN "HELLO WORLD"
 274 -}
 275
 276 readFile :: MonadSafe m => FilePath -> Producer Text m ()
 277 readFile file = Safe.withFile file IO.ReadMode fromHandle
 278 {-# INLINE readFile #-}
 279
 280
 281 {-| Stream text to 'stdout'
 282
 283     Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe.
 284
 285     Note: For best performance, it might be best just to use @(for source (liftIO . putStr))@
 286     instead of @(source >-> stdout)@ .
 287 -}
 288 stdout :: MonadIO m => Consumer' Text m ()
 289 stdout = go
 290   where
 291     go = do
 292         txt <- await
 293         x  <- liftIO $ try (T.putStr txt)
 294         case x of
 295             Left (G.IOError { G.ioe_type  = G.ResourceVanished
 296                             , G.ioe_errno = Just ioe })
 297                  | Errno ioe == ePIPE
 298                      -> return ()
 299             Left  e  -> liftIO (throwIO e)
 300             Right () -> go
 301 {-# INLINABLE stdout #-}
 302
 303
 304 {-| Convert a text stream into a 'Handle'
 305
 306     Note: again, for best performance, where possible use
 307     @(for source (liftIO . hPutStr handle))@ instead of @(source >-> toHandle handle)@.
 308 -}
 309 toHandle :: MonadIO m => IO.Handle -> Consumer' Text m r
 310 toHandle h = for cat (liftIO . T.hPutStr h)
 311 {-# INLINABLE toHandle #-}
 312
 313 {-# RULES "p >-> toHandle h" forall p h .
 314         p >-> toHandle h = for p (\txt -> liftIO (T.hPutStr h txt))
 315   #-}
 316
 317
 318 -- | Stream text into a file. Uses @pipes-safe@.
 319 writeFile :: (MonadSafe m) => FilePath -> Consumer' Text m ()
 320 writeFile file = Safe.withFile file IO.WriteMode toHandle
 321 {-# INLINE writeFile #-}
 322
 323
 324 type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
 325
 326 type Iso' a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a)
 327
 328 (^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
 329 a ^. lens = getConstant (lens Constant a)
 330
 331
 332 -- | Apply a transformation to each 'Char' in the stream
 333 map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
 334 map f = P.map (T.map f)
 335 {-# INLINABLE map #-}
 336
 337 {-# RULES "p >-> map f" forall p f .
 338         p >-> map f = for p (\txt -> yield (T.map f txt))
 339   #-}
 340
 341 -- | Map a function over the characters of a text stream and concatenate the results
 342 concatMap
 343     :: (Monad m) => (Char -> Text) -> Pipe Text Text m r
 344 concatMap f = P.map (T.concatMap f)
 345 {-# INLINABLE concatMap #-}
 346
 347 {-# RULES "p >-> concatMap f" forall p f .
 348         p >-> concatMap f = for p (\txt -> yield (T.concatMap f txt))
 349   #-}
 350
 351 -- | Transform a Pipe of 'Text' into a Pipe of 'ByteString's using UTF-8
 352 -- encoding; @encodeUtf8 = Pipes.Prelude.map TE.encodeUtf8@ so more complex
 353 -- encoding pipes can easily be constructed with the functions in @Data.Text.Encoding@
 354 encodeUtf8 :: Monad m => Pipe Text ByteString m r
 355 encodeUtf8 = P.map TE.encodeUtf8
 356 {-# INLINEABLE encodeUtf8 #-}
 357
 358 {-# RULES "p >-> encodeUtf8" forall p .
 359         p >-> encodeUtf8 = for p (\txt -> yield (TE.encodeUtf8 txt))
 360   #-}
 361
 362 -- | Transform a Pipe of 'String's into one of 'Text' chunks
 363 pack :: Monad m => Pipe String Text m r
 364 pack = P.map T.pack
 365 {-# INLINEABLE pack #-}
 366
 367 {-# RULES "p >-> pack" forall p .
 368         p >-> pack = for p (\txt -> yield (T.pack txt))
 369   #-}
 370
 371 -- | Transform a Pipes of 'Text' chunks into one of 'String's
 372 unpack :: Monad m => Pipe Text String m r
 373 unpack = for cat (\t -> yield (T.unpack t))
 374 {-# INLINEABLE unpack #-}
 375
 376 {-# RULES "p >-> unpack" forall p .
 377         p >-> unpack = for p (\txt -> yield (T.unpack txt))
 378   #-}
 379
 380 -- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities,
 381 -- here acting as 'Text' pipes, rather as they would  on a lazy text
 382 toCaseFold :: Monad m => Pipe Text Text m ()
 383 toCaseFold = P.map T.toCaseFold
 384 {-# INLINEABLE toCaseFold #-}
 385
 386 {-# RULES "p >-> toCaseFold" forall p .
 387         p >-> toCaseFold = for p (\txt -> yield (T.toCaseFold txt))
 388   #-}
 389
 390
 391 -- | lowercase incoming 'Text'
 392 toLower :: Monad m => Pipe Text Text m ()
 393 toLower = P.map T.toLower
 394 {-# INLINEABLE toLower #-}
 395
 396 {-# RULES "p >-> toLower" forall p .
 397         p >-> toLower = for p (\txt -> yield (T.toLower txt))
 398   #-}
 399
 400 -- | uppercase incoming 'Text'
 401 toUpper :: Monad m => Pipe Text Text m ()
 402 toUpper = P.map T.toUpper
 403 {-# INLINEABLE toUpper #-}
 404
 405 {-# RULES "p >-> toUpper" forall p .
 406         p >-> toUpper = for p (\txt -> yield (T.toUpper txt))
 407   #-}
 408
 409 -- | Remove leading white space from an incoming succession of 'Text's
 410 stripStart :: Monad m => Pipe Text Text m r
 411 stripStart = do
 412     chunk <- await
 413     let text = T.stripStart chunk
 414     if T.null text
 415       then stripStart
 416       else do yield text
 417               cat
 418 {-# INLINEABLE stripStart #-}
 419
 420 -- | @(take n)@ only allows @n@ individual characters to pass;
 421 --  contrast @Pipes.Prelude.take@ which would let @n@ chunks pass.
 422 take :: (Monad m, Integral a) => a -> Pipe Text Text m ()
 423 take n0 = go n0 where
 424     go n
 425         | n <= 0    = return ()
 426         | otherwise = do
 427             txt <- await
 428             let len = fromIntegral (T.length txt)
 429             if (len > n)
 430                 then yield (T.take (fromIntegral n) txt)
 431                 else do
 432                     yield txt
 433                     go (n - len)
 434 {-# INLINABLE take #-}
 435
 436 -- | @(drop n)@ drops the first @n@ characters
 437 drop :: (Monad m, Integral a) => a -> Pipe Text Text m r
 438 drop n0 = go n0 where
 439     go n
 440         | n <= 0    = cat
 441         | otherwise = do
 442             txt <- await
 443             let len = fromIntegral (T.length txt)
 444             if (len >= n)
 445                 then do
 446                     yield (T.drop (fromIntegral n) txt)
 447                     cat
 448                 else go (n - len)
 449 {-# INLINABLE drop #-}
 450
 451 -- | Take characters until they fail the predicate
 452 takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m ()
 453 takeWhile predicate = go
 454   where
 455     go = do
 456         txt <- await
 457         let (prefix, suffix) = T.span predicate txt
 458         if (T.null suffix)
 459             then do
 460                 yield txt
 461                 go
 462             else yield prefix
 463 {-# INLINABLE takeWhile #-}
 464
 465 -- | Drop characters until they fail the predicate
 466 dropWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
 467 dropWhile predicate = go where
 468     go = do
 469         txt <- await
 470         case T.findIndex (not . predicate) txt of
 471             Nothing -> go
 472             Just i -> do
 473                 yield (T.drop i txt)
 474                 cat
 475 {-# INLINABLE dropWhile #-}
 476
 477 -- | Only allows 'Char's to pass if they satisfy the predicate
 478 filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
 479 filter predicate = P.map (T.filter predicate)
 480 {-# INLINABLE filter #-}
 481
 482 {-# RULES "p >-> filter q" forall p q .
 483         p >-> filter q = for p (\txt -> yield (T.filter q txt))
 484   #-}
 485
 486 -- | Strict left scan over the characters
 487 scan
 488     :: (Monad m)
 489     => (Char -> Char -> Char) -> Char -> Pipe Text Text m r
 490 scan step begin = go begin
 491   where
 492     go c = do
 493         txt <- await
 494         let txt' = T.scanl step c txt
 495             c' = T.last txt'
 496         yield txt'
 497         go c'
 498 {-# INLINABLE scan #-}
 499
 500 {-| Fold a pure 'Producer' of strict 'Text's into a lazy
 501     'TL.Text'
 502 -}
 503 toLazy :: Producer Text Identity () -> TL.Text
 504 toLazy = TL.fromChunks . P.toList
 505 {-# INLINABLE toLazy #-}
 506
 507 {-| Fold an effectful 'Producer' of strict 'Text's into a lazy
 508     'TL.Text'
 509
 510     Note: 'toLazyM' is not an idiomatic use of @pipes@, but I provide it for
 511     simple testing purposes.  Idiomatic @pipes@ style consumes the chunks
 512     immediately as they are generated instead of loading them all into memory.
 513 -}
 514 toLazyM :: (Monad m) => Producer Text m () -> m TL.Text
 515 toLazyM = liftM TL.fromChunks . P.toListM
 516 {-# INLINABLE toLazyM #-}
 517
 518 -- | Reduce the text stream using a strict left fold over characters
 519 foldChars
 520     :: Monad m
 521     => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r
 522 foldChars step begin done = P.fold (T.foldl' step) begin done
 523 {-# INLINABLE foldChars #-}
 524
 525 -- | Retrieve the first 'Char'
 526 head :: (Monad m) => Producer Text m () -> m (Maybe Char)
 527 head = go
 528   where
 529     go p = do
 530         x <- nextChar p
 531         case x of
 532             Left   _      -> return  Nothing
 533             Right (c, _) -> return (Just c)
 534 {-# INLINABLE head #-}
 535
 536 -- | Retrieve the last 'Char'
 537 last :: (Monad m) => Producer Text m () -> m (Maybe Char)
 538 last = go Nothing
 539   where
 540     go r p = do
 541         x <- next p
 542         case x of
 543             Left   ()      -> return r
 544             Right (txt, p') ->
 545                 if (T.null txt)
 546                 then go r p'
 547                 else go (Just $ T.last txt) p'
 548 {-# INLINABLE last #-}
 549
 550 -- | Determine if the stream is empty
 551 null :: (Monad m) => Producer Text m () -> m Bool
 552 null = P.all T.null
 553 {-# INLINABLE null #-}
 554
 555 -- | Count the number of characters in the stream
 556 length :: (Monad m, Num n) => Producer Text m () -> m n
 557 length = P.fold (\n txt -> n + fromIntegral (T.length txt)) 0 id
 558 {-# INLINABLE length #-}
 559
 560 -- | Fold that returns whether 'M.Any' received 'Char's satisfy the predicate
 561 any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
 562 any predicate = P.any (T.any predicate)
 563 {-# INLINABLE any #-}
 564
 565 -- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate
 566 all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
 567 all predicate = P.all (T.all predicate)
 568 {-# INLINABLE all #-}
 569
 570 -- | Return the maximum 'Char' within a text stream
 571 maximum :: (Monad m) => Producer Text m () -> m (Maybe Char)
 572 maximum = P.fold step Nothing id
 573   where
 574     step mc txt =
 575         if (T.null txt)
 576         then mc
 577         else Just $ case mc of
 578             Nothing -> T.maximum txt
 579             Just c -> max c (T.maximum txt)
 580 {-# INLINABLE maximum #-}
 581
 582 -- | Return the minimum 'Char' within a text stream (surely very useful!)
 583 minimum :: (Monad m) => Producer Text m () -> m (Maybe Char)
 584 minimum = P.fold step Nothing id
 585   where
 586     step mc txt =
 587         if (T.null txt)
 588         then mc
 589         else case mc of
 590             Nothing -> Just (T.minimum txt)
 591             Just c -> Just (min c (T.minimum txt))
 592 {-# INLINABLE minimum #-}
 593
 594
 595 -- | Find the first element in the stream that matches the predicate
 596 find
 597     :: (Monad m)
 598     => (Char -> Bool) -> Producer Text m () -> m (Maybe Char)
 599 find predicate p = head (p >-> filter predicate)
 600 {-# INLINABLE find #-}
 601
 602 -- | Index into a text stream
 603 index
 604     :: (Monad m, Integral a)
 605     => a-> Producer Text m () -> m (Maybe Char)
 606 index n p = head (p >-> drop n)
 607 {-# INLINABLE index #-}
 608
 609
 610 -- | Store a tally of how many segments match the given 'Text'
 611 count :: (Monad m, Num n) => Text -> Producer Text m () -> m n
 612 count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c))
 613 {-# INLINABLE count #-}
 614
 615
 616 {-| Consume the first character from a stream of 'Text'
 617
 618     'next' either fails with a 'Left' if the 'Producer' has no more characters or
 619     succeeds with a 'Right' providing the next character and the remainder of the
 620     'Producer'.
 621 -}
 622 nextChar
 623     :: (Monad m)
 624     => Producer Text m r
 625     -> m (Either r (Char, Producer Text m r))
 626 nextChar = go
 627   where
 628     go p = do
 629         x <- next p
 630         case x of
 631             Left   r       -> return (Left r)
 632             Right (txt, p') -> case (T.uncons txt) of
 633                 Nothing        -> go p'
 634                 Just (c, txt') -> return (Right (c, yield txt' >> p'))
 635 {-# INLINABLE nextChar #-}
 636
 637 {-| Draw one 'Char' from a stream of 'Text', returning 'Left' if the
 638     'Producer' is empty
 639 -}
 640 drawChar :: (Monad m) => Parser Text m (Maybe Char)
 641 drawChar = do
 642     x <- PP.draw
 643     case x of
 644         Nothing  -> return Nothing
 645         Just txt -> case (T.uncons txt) of
 646             Nothing        -> drawChar
 647             Just (c, txt') -> do
 648                 PP.unDraw txt'
 649                 return (Just c)
 650 {-# INLINABLE drawChar #-}
 651
 652 -- | Push back a 'Char' onto the underlying 'Producer'
 653 unDrawChar :: (Monad m) => Char -> Parser Text m ()
 654 unDrawChar c = modify (yield (T.singleton c) >>)
 655 {-# INLINABLE unDrawChar #-}
 656
 657 {-| 'peekChar' checks the first 'Char' in the stream, but uses 'unDrawChar' to
 658     push the 'Char' back
 659
 660 > peekChar = do
 661 >     x <- drawChar
 662 >     case x of
 663 >         Left  _  -> return ()
 664 >         Right c -> unDrawChar c
 665 >     return x
 666 -}
 667 peekChar :: (Monad m) => Parser Text m (Maybe Char)
 668 peekChar = do
 669     x <- drawChar
 670     case x of
 671         Nothing  -> return ()
 672         Just c -> unDrawChar c
 673     return x
 674 {-# INLINABLE peekChar #-}
 675
 676 {-| Check if the underlying 'Producer' has no more characters
 677
 678     Note that this will skip over empty 'Text' chunks, unlike
 679     'PP.isEndOfInput' from @pipes-parse@, which would consider
 680     an empty 'Text' a valid bit of input.
 681
 682 > isEndOfChars = liftM isLeft peekChar
 683 -}
 684 isEndOfChars :: (Monad m) => Parser Text m Bool
 685 isEndOfChars = do
 686     x <- peekChar
 687     return (case x of
 688         Nothing -> True
 689         Just _-> False )
 690 {-# INLINABLE isEndOfChars #-}
 691
 692
 693 {- | An improper lens into a stream of 'ByteString' expected to be UTF-8 encoded; the associated
 694    stream of Text ends by returning a stream of ByteStrings beginning at the point of failure.
 695    -}
 696
 697 decodeUtf8 :: Monad m => Lens' (Producer ByteString m r)
 698                                (Producer Text m (Producer ByteString m r))
 699 decodeUtf8 k p0 = fmap (\p -> join  (for p (yield . TE.encodeUtf8)))
 700                        (k (go B.empty PI.streamDecodeUtf8 p0)) where
 701   go !carry dec0 p = do
 702      x <- lift (next p)
 703      case x of Left r -> return (if B.null carry
 704                                     then return r -- all bytestring input was consumed
 705                                     else (do yield carry -- a potentially valid fragment remains
 706                                              return r))
 707
 708                Right (chunk, p') -> case dec0 chunk of
 709                    PI.Some text carry2 dec -> do yield text
 710                                                  go carry2 dec p'
 711                    PI.Other text bs -> do yield text
 712                                           return (do yield bs -- an invalid blob remains
 713                                                      p')
 714 {-# INLINABLE decodeUtf8 #-}
 715
 716
 717 -- | Splits a 'Producer' after the given number of characters
 718 splitAt
 719     :: (Monad m, Integral n)
 720     => n
 721     -> Lens' (Producer Text m r)
 722              (Producer Text m (Producer Text m r))
 723 splitAt n0 k p0 = fmap join (k (go n0 p0))
 724   where
 725     go 0 p = return p
 726     go n p = do
 727         x <- lift (next p)
 728         case x of
 729             Left   r       -> return (return r)
 730             Right (txt, p') -> do
 731                 let len = fromIntegral (T.length txt)
 732                 if (len <= n)
 733                     then do
 734                         yield txt
 735                         go (n - len) p'
 736                     else do
 737                         let (prefix, suffix) = T.splitAt (fromIntegral n) txt
 738                         yield prefix
 739                         return (yield suffix >> p')
 740 {-# INLINABLE splitAt #-}
 741
 742
 743 {-| Split a text stream in two, where the first text stream is the longest
 744     consecutive group of text that satisfy the predicate
 745 -}
 746 span
 747     :: (Monad m)
 748     => (Char -> Bool)
 749     -> Lens' (Producer Text m r)
 750              (Producer Text m (Producer Text m r))
 751 span predicate k p0 = fmap join (k (go p0))
 752   where
 753     go p = do
 754         x <- lift (next p)
 755         case x of
 756             Left   r       -> return (return r)
 757             Right (txt, p') -> do
 758                 let (prefix, suffix) = T.span predicate txt
 759                 if (T.null suffix)
 760                     then do
 761                         yield txt
 762                         go p'
 763                     else do
 764                         yield prefix
 765                         return (yield suffix >> p')
 766 {-# INLINABLE span #-}
 767
 768 {-| Split a text stream in two, where the first text stream is the longest
 769     consecutive group of characters that don't satisfy the predicate
 770 -}
 771 break
 772     :: (Monad m)
 773     => (Char -> Bool)
 774     -> Lens' (Producer Text m r)
 775              (Producer Text m (Producer Text m r))
 776 break predicate = span (not . predicate)
 777 {-# INLINABLE break #-}
 778
 779 {-| Improper lens that splits after the first group of equivalent Chars, as
 780     defined by the given equivalence relation
 781 -}
 782 groupBy
 783     :: (Monad m)
 784     => (Char -> Char -> Bool)
 785     -> Lens' (Producer Text m r)
 786              (Producer Text m (Producer Text m r))
 787 groupBy equals k p0 = fmap join (k ((go p0))) where
 788     go p = do
 789         x <- lift (next p)
 790         case x of
 791             Left   r       -> return (return r)
 792             Right (txt, p') -> case T.uncons txt of
 793                 Nothing      -> go p'
 794                 Just (c, _) -> (yield txt >> p') ^. span (equals c)
 795 {-# INLINABLE groupBy #-}
 796
 797 -- | Improper lens that splits after the first succession of identical 'Char' s
 798 group :: Monad m
 799       => Lens' (Producer Text m r)
 800                (Producer Text m (Producer Text m r))
 801 group = groupBy (==)
 802 {-# INLINABLE group #-}
 803
 804 {-| Improper lens that splits a 'Producer' after the first word
 805
 806     Unlike 'words', this does not drop leading whitespace
 807 -}
 808 word :: (Monad m)
 809      => Lens' (Producer Text m r)
 810               (Producer Text m (Producer Text m r))
 811 word k p0 = fmap join (k (to p0))
 812   where
 813     to p = do
 814         p' <- p^.span isSpace
 815         p'^.break isSpace
 816 {-# INLINABLE word #-}
 817
 818
 819 line :: (Monad m)
 820      => Lens' (Producer Text m r)
 821               (Producer Text m (Producer Text m r))
 822 line = break (== '\n')
 823
 824 {-# INLINABLE line #-}
 825
 826
 827 -- | Intersperse a 'Char' in between the characters of stream of 'Text'
 828 intersperse
 829     :: (Monad m) => Char -> Producer Text m r -> Producer Text m r
 830 intersperse c = go0
 831   where
 832     go0 p = do
 833         x <- lift (next p)
 834         case x of
 835             Left   r       -> return r
 836             Right (txt, p') -> do
 837                 yield (T.intersperse c txt)
 838                 go1 p'
 839     go1 p = do
 840         x <- lift (next p)
 841         case x of
 842             Left   r       -> return r
 843             Right (txt, p') -> do
 844                 yield (T.singleton c)
 845                 yield (T.intersperse c txt)
 846                 go1 p'
 847 {-# INLINABLE intersperse #-}
 848
 849
 850
 851 -- | Improper isomorphism between a 'Producer' of 'ByteString's and 'Word8's
 852 packChars :: Monad m => Iso' (Producer Char m x) (Producer Text m x)
 853 packChars = Data.Profunctor.dimap to (fmap from)
 854   where
 855     -- to :: Monad m => Producer Char m x -> Producer Text m x
 856     to p = PG.folds step id done (p^.PG.chunksOf defaultChunkSize)
 857
 858     step diffAs c = diffAs . (c:)
 859
 860     done diffAs = T.pack (diffAs [])
 861
 862     -- from :: Monad m => Producer Text m x -> Producer Char m x
 863     from p = for p (each . T.unpack)
 864 {-# INLINABLE packChars #-}
 865
 866
 867 -- | Split a text stream into 'FreeT'-delimited text streams of fixed size
 868 chunksOf
 869     :: (Monad m, Integral n)
 870     => n -> Lens' (Producer Text m r)
 871                   (FreeT (Producer Text m) m r)
 872 chunksOf n k p0 = fmap concats (k (FreeT (go p0)))
 873   where
 874     go p = do
 875         x <- next p
 876         return $ case x of
 877             Left   r       -> Pure r
 878             Right (txt, p') -> Free $ do
 879                 p'' <- (yield txt >> p') ^. splitAt n
 880                 return $ FreeT (go p'')
 881 {-# INLINABLE chunksOf #-}
 882
 883
 884 {-| Split a text stream into sub-streams delimited by characters that satisfy the
 885     predicate
 886 -}
 887 splitsWith
 888     :: (Monad m)
 889     => (Char -> Bool)
 890     -> Producer Text m r
 891     -> FreeT (Producer Text m) m r
 892 splitsWith predicate p0 = FreeT (go0 p0)
 893   where
 894     go0 p = do
 895         x <- next p
 896         case x of
 897             Left   r       -> return (Pure r)
 898             Right (txt, p') ->
 899                 if (T.null txt)
 900                 then go0 p'
 901                 else return $ Free $ do
 902                     p'' <-  (yield txt >> p') ^. span (not . predicate)
 903                     return $ FreeT (go1 p'')
 904     go1 p = do
 905         x <- nextChar p
 906         return $ case x of
 907             Left   r      -> Pure r
 908             Right (_, p') -> Free $ do
 909                     p'' <- p' ^. span (not . predicate)
 910                     return $ FreeT (go1 p'')
 911 {-# INLINABLE splitsWith #-}
 912
 913 -- | Split a text stream using the given 'Char' as the delimiter
 914 splits :: (Monad m)
 915       => Char
 916       -> Lens' (Producer Text m r)
 917                (FreeT (Producer Text m) m r)
 918 splits c k p =
 919           fmap (PG.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p))
 920 {-# INLINABLE splits #-}
 921
 922 {-| Isomorphism between a stream of 'Text' and groups of equivalent 'Char's , using the
 923     given equivalence relation
 924 -}
 925 groupsBy
 926     :: Monad m
 927     => (Char -> Char -> Bool)
 928     -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x)
 929 groupsBy equals k p0 = fmap concats (k (FreeT (go p0))) where
 930   go p = do x <- next p
 931             case x of Left   r       -> return (Pure r)
 932                       Right (bs, p') -> case T.uncons bs of
 933                              Nothing      -> go p'
 934                              Just (c, _) -> do return $ Free $ do
 935                                                  p'' <- (yield bs >> p')^.span (equals c)
 936                                                  return $ FreeT (go p'')
 937 {-# INLINABLE groupsBy #-}
 938
 939
 940 -- | Like 'groupsBy', where the equality predicate is ('==')
 941 groups
 942     :: Monad m
 943     => Lens' (Producer Text m x) (FreeT (Producer Text m) m x)
 944 groups = groupsBy (==)
 945 {-# INLINABLE groups #-}
 946
 947
 948
 949 {-| Split a text stream into 'FreeT'-delimited lines
 950 -}
 951 lines
 952     :: (Monad m) => Iso' (Producer Text m r)  (FreeT (Producer Text m) m r)
 953 lines = Data.Profunctor.dimap _lines (fmap _unlines)
 954   where
 955   _lines p0 = FreeT (go0 p0)
 956     where
 957       go0 p = do
 958               x <- next p
 959               case x of
 960                   Left   r       -> return (Pure r)
 961                   Right (txt, p') ->
 962                       if (T.null txt)
 963                       then go0 p'
 964                       else return $ Free $ go1 (yield txt >> p')
 965       go1 p = do
 966               p' <- p ^. break ('\n' ==)
 967               return $ FreeT $ do
 968                   x  <- nextChar p'
 969                   case x of
 970                       Left   r      -> return $ Pure r
 971                       Right (_, p'') -> go0 p''
 972   -- _unlines
 973   --     :: Monad m
 974   --      => FreeT (Producer Text m) m x -> Producer Text m x
 975   _unlines = concats . PG.maps (<* yield (T.singleton '\n'))
 976
 977
 978 {-# INLINABLE lines #-}
 979
 980
 981 -- | Split a text stream into 'FreeT'-delimited words
 982 words
 983     :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r)
 984 words = Data.Profunctor.dimap go (fmap _unwords)
 985   where
 986     go p = FreeT $ do
 987         x <- next (p >-> dropWhile isSpace)
 988         return $ case x of
 989             Left   r       -> Pure r
 990             Right (bs, p') -> Free $ do
 991                 p'' <-  (yield bs >> p') ^. break isSpace
 992                 return (go p'')
 993     _unwords = PG.intercalates (yield $ T.singleton ' ')
 994
 995 {-# INLINABLE words #-}
 996
 997
 998 {-| 'intercalate' concatenates the 'FreeT'-delimited text streams after
 999     interspersing a text stream in between them
1000 -}
1001 intercalate
1002     :: (Monad m)
1003     => Producer Text m ()
1004     -> FreeT (Producer Text m) m r
1005     -> Producer Text m r
1006 intercalate p0 = go0
1007   where
1008     go0 f = do
1009         x <- lift (runFreeT f)
1010         case x of
1011             Pure r -> return r
1012             Free p -> do
1013                 f' <- p
1014                 go1 f'
1015     go1 f = do
1016         x <- lift (runFreeT f)
1017         case x of
1018             Pure r -> return r
1019             Free p -> do
1020                 p0
1021                 f' <- p
1022                 go1 f'
1023 {-# INLINABLE intercalate #-}
1024
1025 {-| Join 'FreeT'-delimited lines into a text stream
1026 -}
1027 unlines
1028     :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
1029 unlines = go
1030   where
1031     go f = do
1032         x <- lift (runFreeT f)
1033         case x of
1034             Pure r -> return r
1035             Free p -> do
1036                 f' <- p
1037                 yield $ T.singleton '\n'
1038                 go f'
1039 {-# INLINABLE unlines #-}
1040
1041 {-| Join 'FreeT'-delimited words into a text stream
1042 -}
1043 unwords
1044     :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
1045 unwords = intercalate (yield $ T.singleton ' ')
1046 {-# INLINABLE unwords #-}
1047
1048 {- $parse
1049     The following parsing utilities are single-character analogs of the ones found
1050     @pipes-parse@.
1051 -}
1052
1053 {- $reexports
1054
1055     @Data.Text@ re-exports the 'Text' type.
1056
1057     @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym.
1058 -}
1059
1060 {- | Use a 'Codec' as a pipes-style 'Lens' into a byte stream; the available 'Codec' s are
1061      'utf8', 'utf16_le', 'utf16_be', 'utf32_le', 'utf32_be' . The 'Codec' concept and the
1062      individual 'Codec' definitions follow the enumerator and conduit libraries.
1063
1064      Utf8 is handled differently in this library -- without the use of 'unsafePerformIO' &co
1065      to catch 'Text' exceptions; but the same 'mypipe ^. codec utf8' interface can be used.
1066      'mypipe ^. decodeUtf8' should be the same, but has a somewhat more direct and thus perhaps
1067      better implementation.
1068
1069      -}
1070 codec :: Monad m => Codec -> Lens' (Producer ByteString m r) (Producer Text m (Producer ByteString m r))
1071 codec (Codec _ enc dec) k p0 = fmap (\p -> join (for p (yield . fst . enc)))
1072                                      (k (decoder (dec B.empty) p0) ) where
1073   decoder :: Monad m => PI.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r)
1074   decoder !d p0 = case d of
1075       PI.Other txt bad      -> do yield txt
1076                                   return (do yield bad
1077                                              p0)
1078       PI.Some txt extra dec -> do yield txt
1079                                   x <- lift (next p0)
1080                                   case x of Left r -> return (do yield extra
1081                                                                  return r)
1082                                             Right (chunk,p1) -> decoder (dec chunk) p1
1083
1084 {- | ascii and latin encodings only represent a small fragment of 'Text'; thus we cannot
1085      use the pipes 'Lens' style to work with them. Rather we simply define functions
1086      each way.
1087
1088      'encodeAscii' : Reduce as much of your stream of 'Text' actually is ascii to a byte stream,
1089      returning the rest of the 'Text' at the first non-ascii 'Char'
1090 -}
1091 encodeAscii :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r)
1092 encodeAscii = go where
1093   go p = do echunk <- lift (next p)
1094             case echunk of
1095               Left r -> return (return r)
1096               Right (chunk, p') ->
1097                  if T.null chunk
1098                    then go p'
1099                    else let (safe, unsafe)  = T.span (\c -> ord c <= 0x7F) chunk
1100                         in do yield (B8.pack (T.unpack safe))
1101                               if T.null unsafe
1102                                 then go p'
1103                                 else return $ do yield unsafe
1104                                                  p'
1105 {- | Reduce as much of your stream of 'Text' actually is iso8859 or latin1 to a byte stream,
1106      returning the rest of the 'Text' upon hitting any non-latin 'Char'
1107    -}
1108 encodeIso8859_1 :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r)
1109 encodeIso8859_1 = go where
1110   go p = do etxt <- lift (next p)
1111             case etxt of
1112               Left r -> return (return r)
1113               Right (txt, p') ->
1114                  if T.null txt
1115                    then go p'
1116                    else let (safe, unsafe)  = T.span (\c -> ord c <= 0xFF) txt
1117                         in do yield (B8.pack (T.unpack safe))
1118                               if T.null unsafe
1119                                 then go p'
1120                                 else return $ do yield unsafe
1121                                                  p'
1122
1123 {- | Reduce a byte stream to a corresponding stream of ascii chars, returning the
1124      unused 'ByteString' upon hitting an un-ascii byte.
1125    -}
1126 decodeAscii :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
1127 decodeAscii = go where
1128   go p = do echunk <- lift (next p)
1129             case echunk of
1130               Left r -> return (return r)
1131               Right (chunk, p') ->
1132                  if B.null chunk
1133                    then go p'
1134                    else let (safe, unsafe)  = B.span (<= 0x7F) chunk
1135                         in do yield (T.pack (B8.unpack safe))
1136                               if B.null unsafe
1137                                 then go p'
1138                                 else return $ do yield unsafe
1139                                                  p'
1140
1141 {- | Reduce a byte stream to a corresponding stream of ascii chars, returning the
1142      unused 'ByteString' upon hitting the rare un-latinizable byte.
1143      -}
1144 decodeIso8859_1 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
1145 decodeIso8859_1 = go where
1146   go p = do echunk <- lift (next p)
1147             case echunk of
1148               Left r -> return (return r)
1149               Right (chunk, p') ->
1150                  if B.null chunk
1151                    then go p'
1152                    else let (safe, unsafe)  = B.span (<= 0xFF) chunk
1153                         in do yield (T.pack (B8.unpack safe))
1154                               if B.null unsafe
1155                                 then go p'
1156                                 else return $ do yield unsafe
1157                                                  p'
1158
1159
1160
1161
1162