1 {-# LANGUAGE RankNTypes, TypeFamilies, CPP #-}
3 {-| This module provides @pipes@ utilities for \"text streams\", which are
4 streams of 'Text' chunks. The individual chunks are uniformly @strict@, but
5 a 'Producer' can be converted to and from lazy 'Text's; an 'IO.Handle' can
6 be associated with a 'Producer' or 'Consumer' according as it is read or written to.
8 To stream to or from 'IO.Handle's, one can use 'fromHandle' or 'toHandle'. For
9 example, the following program copies a document from one file to another:
12 > import qualified Data.Text.Pipes as Text
16 > withFile "inFile.txt" ReadMode $ \hIn ->
17 > withFile "outFile.txt" WriteMode $ \hOut ->
18 > runEffect $ Text.fromHandle hIn >-> Text.toHandle hOut
20 To stream from files, the following is perhaps more Prelude-like (note that it uses Pipes.Safe):
23 > import qualified Data.Text.Pipes as Text
26 > main = runSafeT $ runEffect $ Text.readFile "inFile.txt" >-> Text.writeFile "outFile.txt"
28 You can stream to and from 'stdin' and 'stdout' using the predefined 'stdin'
29 and 'stdout' proxies, as with the following \"echo\" program:
31 > main = runEffect $ Text.stdin >-> Text.stdout
33 You can also translate pure lazy 'TL.Text's to and from proxies:
35 > main = runEffect $ Text.fromLazy (TL.pack "Hello, world!\n") >-> Text.stdout
37 In addition, this module provides many functions equivalent to lazy
38 'Text' functions so that you can transform or fold text streams. For
39 example, to stream only the first three lines of 'stdin' to 'stdout' you
43 > import qualified Pipes.Text as Text
44 > import qualified Pipes.Parse as Parse
46 > main = runEffect $ takeLines 3 Text.stdin >-> Text.stdout
48 > takeLines n = Text.unlines . Parse.takeFree n . Text.lines
50 The above program will never bring more than one chunk of text (~ 32 KB) into
51 memory, no matter how long the lines are.
53 Note that functions in this library are designed to operate on streams that
54 are insensitive to text boundaries. This means that they may freely split
55 text into smaller texts and /discard empty texts/. However, they will
56 /never concatenate texts/ in order to provide strict upper bounds on memory
84 #if MIN_VERSION_text(0,11,4)
122 #if MIN_VERSION_text(0,11,4)
134 -- * Character Parsers
148 import Control.Exception (throwIO, try)
149 import Control.Monad (liftM, unless)
150 import Control.Monad.Trans.State.Strict (StateT(..))
151 import qualified Data.Text as T
152 import qualified Data.Text.IO as T
153 import qualified Data.Text.Encoding as TE
154 import qualified Data.Text.Encoding.Error as TE
155 import Data.Text (Text)
156 import qualified Data.Text.Lazy as TL
157 import qualified Data.Text.Lazy.IO as TL
158 import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize)
159 import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)
160 import Data.ByteString (ByteString)
161 import qualified Data.ByteString as B
162 import Data.Char (ord, isSpace)
163 import Data.Functor.Identity (Identity)
164 import qualified Data.List as List
165 import Foreign.C.Error (Errno(Errno), ePIPE)
166 import qualified GHC.IO.Exception as G
168 import qualified Pipes.ByteString.Parse as PBP
169 import Pipes.Text.Parse (
170 nextChar, drawChar, unDrawChar, peekChar, isEndOfChars )
171 import Pipes.Core (respond, Server')
172 import qualified Pipes.Parse as PP
173 import Pipes.Parse (input, concat, FreeT)
174 import qualified Pipes.Safe.Prelude as Safe
175 import qualified Pipes.Safe as Safe
176 import Pipes.Safe (MonadSafe(..), Base(..))
177 import qualified Pipes.Prelude as P
178 import qualified System.IO as IO
179 import Data.Char (isSpace)
180 import Data.Word (Word8)
181 import Prelude hiding (
210 -- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's
211 fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
212 fromLazy = foldrChunks (\e a -> yield e >> a) (return ())
213 {-# INLINABLE fromLazy #-}
215 -- | Stream text from 'stdin'
216 stdin :: MonadIO m => Producer' Text m ()
217 stdin = fromHandle IO.stdin
218 {-# INLINABLE stdin #-}
220 {-| Convert a 'IO.Handle' into a text stream using a text size
221 determined by the good sense of the text library.
225 fromHandle :: MonadIO m => IO.Handle -> Producer' Text m ()
226 fromHandle h = go where
227 go = do txt <- liftIO (T.hGetChunk h)
228 unless (T.null txt) $ do yield txt
230 {-# INLINABLE fromHandle#-}
232 {-| Stream text from a file using Pipes.Safe
234 >>> runSafeT $ runEffect $ Text.readFile "hello.hs" >-> Text.map toUpper >-> hoist lift Text.stdout
235 MAIN = PUTSTRLN "HELLO WORLD"
238 readFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Producer' Text m ()
239 readFile file = Safe.withFile file IO.ReadMode fromHandle
240 {-# INLINABLE readFile #-}
242 {-| Stream lines of text from stdin (for testing in ghci etc.)
244 >>> let safely = runSafeT . runEffect
245 >>> safely $ for Text.stdinLn (lift . lift . print . T.length)
252 stdinLn :: MonadIO m => Producer' Text m ()
255 eof <- liftIO (IO.hIsEOF IO.stdin)
257 txt <- liftIO (T.hGetLine IO.stdin)
262 {-| Stream text to 'stdout'
264 Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe.
266 Note: For best performance, use @(for source (liftIO . putStr))@ instead of
267 @(source >-> stdout)@ in suitable cases.
269 stdout :: MonadIO m => Consumer' Text m ()
274 x <- liftIO $ try (T.putStr txt)
276 Left (G.IOError { G.ioe_type = G.ResourceVanished
277 , G.ioe_errno = Just ioe })
280 Left e -> liftIO (throwIO e)
282 {-# INLINABLE stdout #-}
284 stdoutLn :: (MonadIO m) => Consumer' Text m ()
289 x <- liftIO $ try (T.putStrLn str)
291 Left (G.IOError { G.ioe_type = G.ResourceVanished
292 , G.ioe_errno = Just ioe })
295 Left e -> liftIO (throwIO e)
297 {-# INLINABLE stdoutLn #-}
299 {-| Convert a text stream into a 'Handle'
301 Note: again, for best performance, where possible use
302 @(for source (liftIO . hPutStr handle))@ instead of @(source >-> toHandle handle)@.
304 toHandle :: MonadIO m => IO.Handle -> Consumer' Text m r
305 toHandle h = for cat (liftIO . T.hPutStr h)
306 {-# INLINABLE toHandle #-}
308 -- | Stream text into a file. Uses @pipes-safe@.
309 writeFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Consumer' Text m ()
310 writeFile file = Safe.withFile file IO.WriteMode toHandle
312 -- | Apply a transformation to each 'Char' in the stream
313 map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
314 map f = P.map (T.map f)
315 {-# INLINABLE map #-}
317 -- | Map a function over the characters of a text stream and concatenate the results
319 :: (Monad m) => (Char -> Text) -> Pipe Text Text m r
320 concatMap f = P.map (T.concatMap f)
321 {-# INLINABLE concatMap #-}
324 -- | Transform a Pipe of 'Text' into a Pipe of 'ByteString's using UTF-8
325 -- encoding; @encodeUtf8 = Pipes.Prelude.map TE.encodeUtf8@ so more complex
326 -- encoding pipes can easily be constructed with the functions in @Data.Text.Encoding@
327 encodeUtf8 :: Monad m => Pipe Text ByteString m r
328 encodeUtf8 = P.map TE.encodeUtf8
329 {-# INLINEABLE encodeUtf8 #-}
331 -- | Transform a Pipe of 'String's into one of 'Text' chunks
332 pack :: Monad m => Pipe String Text m r
334 {-# INLINEABLE pack #-}
336 -- | Transforma a Pipes of 'Text' chunks into one of 'String's
337 unpack :: Monad m => Pipe Text String m r
338 unpack = P.map T.unpack
339 {-# INLINEABLE unpack #-}
341 -- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utility,
342 -- here acting on a 'Text' pipe, rather as they would on a lazy text
343 toCaseFold :: Monad m => Pipe Text Text m ()
344 toCaseFold = P.map T.toCaseFold
345 {-# INLINEABLE toCaseFold #-}
347 -- | lowercase incoming 'Text'
348 toLower :: Monad m => Pipe Text Text m ()
349 toLower = P.map T.toLower
350 {-# INLINEABLE toLower #-}
352 -- | uppercase incoming 'Text'
353 toUpper :: Monad m => Pipe Text Text m ()
354 toUpper = P.map T.toUpper
355 {-# INLINEABLE toUpper #-}
357 -- | Remove leading white space from an incoming succession of 'Text's
358 stripStart :: Monad m => Pipe Text Text m r
361 let text = T.stripStart chunk
365 {-# INLINEABLE stripStart #-}
367 -- | @(take n)@ only allows @n@ individual characters to pass;
368 -- contrast @Pipes.Prelude.take@ which would let @n@ chunks pass.
369 take :: (Monad m, Integral a) => a -> Pipe Text Text m ()
370 take n0 = go n0 where
375 let len = fromIntegral (T.length txt)
377 then yield (T.take (fromIntegral n) txt)
381 {-# INLINABLE take #-}
383 -- | @(drop n)@ drops the first @n@ characters
384 drop :: (Monad m, Integral a) => a -> Pipe Text Text m r
385 drop n0 = go n0 where
390 let len = fromIntegral (T.length txt)
393 yield (T.drop (fromIntegral n) txt)
396 {-# INLINABLE drop #-}
398 -- | Take characters until they fail the predicate
399 takeWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m ()
400 takeWhile predicate = go
404 let (prefix, suffix) = T.span predicate txt
410 {-# INLINABLE takeWhile #-}
412 -- | Drop characters until they fail the predicate
413 dropWhile :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
414 dropWhile predicate = go where
417 case T.findIndex (not . predicate) txt of
422 {-# INLINABLE dropWhile #-}
424 -- | Only allows 'Char's to pass if they satisfy the predicate
425 filter :: (Monad m) => (Char -> Bool) -> Pipe Text Text m r
426 filter predicate = P.map (T.filter predicate)
427 {-# INLINABLE filter #-}
430 -- | Strict left scan over the characters
433 => (Char -> Char -> Char) -> Char -> Pipe Text Text m r
434 scan step begin = go begin
438 let txt' = T.scanl step c txt
442 {-# INLINABLE scan #-}
444 {-| Fold a pure 'Producer' of strict 'Text's into a lazy
447 toLazy :: Producer Text Identity () -> TL.Text
448 toLazy = TL.fromChunks . P.toList
449 {-# INLINABLE toLazy #-}
451 {-| Fold an effectful 'Producer' of strict 'Text's into a lazy
454 Note: 'toLazyM' is not an idiomatic use of @pipes@, but I provide it for
455 simple testing purposes. Idiomatic @pipes@ style consumes the chunks
456 immediately as they are generated instead of loading them all into memory.
458 toLazyM :: (Monad m) => Producer Text m () -> m TL.Text
459 toLazyM = liftM TL.fromChunks . P.toListM
460 {-# INLINABLE toLazyM #-}
462 -- | Reduce the text stream using a strict left fold over characters
465 => (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r
466 fold step begin done = P.fold (T.foldl' step) begin done
467 {-# INLINABLE fold #-}
469 -- | Retrieve the first 'Char'
470 head :: (Monad m) => Producer Text m () -> m (Maybe Char)
476 Left _ -> return Nothing
477 Right (c, _) -> return (Just c)
478 {-# INLINABLE head #-}
480 -- | Retrieve the last 'Char'
481 last :: (Monad m) => Producer Text m () -> m (Maybe Char)
491 else go (Just $ T.last txt) p'
492 {-# INLINABLE last #-}
494 -- | Determine if the stream is empty
495 null :: (Monad m) => Producer Text m () -> m Bool
497 {-# INLINABLE null #-}
499 -- | Count the number of characters in the stream
500 length :: (Monad m, Num n) => Producer Text m () -> m n
501 length = P.fold (\n txt -> n + fromIntegral (T.length txt)) 0 id
502 {-# INLINABLE length #-}
504 -- | Fold that returns whether 'M.Any' received 'Char's satisfy the predicate
505 any :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
506 any predicate = P.any (T.any predicate)
507 {-# INLINABLE any #-}
509 -- | Fold that returns whether 'M.All' received 'Char's satisfy the predicate
510 all :: (Monad m) => (Char -> Bool) -> Producer Text m () -> m Bool
511 all predicate = P.all (T.all predicate)
512 {-# INLINABLE all #-}
514 -- | Return the maximum 'Char' within a text stream
515 maximum :: (Monad m) => Producer Text m () -> m (Maybe Char)
516 maximum = P.fold step Nothing id
521 else Just $ case mc of
522 Nothing -> T.maximum txt
523 Just c -> max c (T.maximum txt)
524 {-# INLINABLE maximum #-}
526 -- | Return the minimum 'Char' within a text stream (surely very useful!)
527 minimum :: (Monad m) => Producer Text m () -> m (Maybe Char)
528 minimum = P.fold step Nothing id
534 Nothing -> Just (T.minimum txt)
535 Just c -> Just (min c (T.minimum txt))
536 {-# INLINABLE minimum #-}
538 -- | Find the first element in the stream that matches the predicate
541 => (Char -> Bool) -> Producer Text m () -> m (Maybe Char)
542 find predicate p = head (p >-> filter predicate)
543 {-# INLINABLE find #-}
545 -- | Index into a text stream
547 :: (Monad m, Integral a)
548 => a-> Producer Text m () -> m (Maybe Char)
549 index n p = head (p >-> drop n)
550 {-# INLINABLE index #-}
553 -- | Store a tally of how many segments match the given 'Text'
554 count :: (Monad m, Num n) => Text -> Producer Text m () -> m n
555 count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c))
556 {-# INLINABLE count #-}
558 #if MIN_VERSION_text(0,11,4)
559 -- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded
560 -- into a Pipe of Text
563 => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
564 decodeUtf8 = go TE.streamDecodeUtf8
568 Left r -> return (return r)
569 Right (chunk, p') -> do
570 let TE.Some text l dec' = dec chunk
578 {-# INLINEABLE decodeUtf8 #-}
580 -- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded
581 -- into a Pipe of Text with a replacement function of type @String -> Maybe Word8 -> Maybe Char@
582 -- E.g. 'Data.Text.Encoding.Error.lenientDecode', which simply replaces bad bytes with \"�\"
586 -> Producer ByteString m r -> Producer Text m (Producer ByteString m r)
587 decodeUtf8With onErr = go (TE.streamDecodeUtf8With onErr)
591 Left r -> return (return r)
592 Right (chunk, p') -> do
593 let TE.Some text l dec' = dec chunk
601 {-# INLINEABLE decodeUtf8With #-}
603 -- | A simple pipe from 'ByteString' to 'Text'; a decoding error will arise
604 -- with any chunk that contains a sequence of bytes that is unreadable. Otherwise
605 -- only few bytes will only be moved from one chunk to the next before decoding.
606 pipeDecodeUtf8 :: Monad m => Pipe ByteString Text m r
607 pipeDecodeUtf8 = go TE.streamDecodeUtf8
608 where go dec = do chunk <- await
610 TE.Some text l dec' -> do yield text
612 {-# INLINEABLE pipeDecodeUtf8 #-}
614 -- | A simple pipe from 'ByteString' to 'Text' using a replacement function.
618 -> Pipe ByteString Text m r
619 pipeDecodeUtf8With onErr = go (TE.streamDecodeUtf8With onErr)
620 where go dec = do chunk <- await
622 TE.Some text l dec' -> do yield text
624 {-# INLINEABLE pipeDecodeUtf8With #-}
627 -- | Splits a 'Producer' after the given number of characters
629 :: (Monad m, Integral n)
632 -> Producer' Text m (Producer Text m r)
639 Left r -> return (return r)
640 Right (txt, p') -> do
641 let len = fromIntegral (T.length txt)
647 let (prefix, suffix) = T.splitAt (fromIntegral n) txt
649 return (yield suffix >> p')
650 {-# INLINABLE splitAt #-}
652 -- | Split a text stream into 'FreeT'-delimited text streams of fixed size
654 :: (Monad m, Integral n)
655 => n -> Producer Text m r -> FreeT (Producer Text m) m r
656 chunksOf n p0 = PP.FreeT (go p0)
662 Right (txt, p') -> PP.Free $ do
663 p'' <- splitAt n (yield txt >> p')
664 return $ PP.FreeT (go p'')
665 {-# INLINABLE chunksOf #-}
667 {-| Split a text stream in two, where the first text stream is the longest
668 consecutive group of text that satisfy the predicate
674 -> Producer' Text m (Producer Text m r)
680 Left r -> return (return r)
681 Right (txt, p') -> do
682 let (prefix, suffix) = T.span predicate txt
689 return (yield suffix >> p')
690 {-# INLINABLE span #-}
692 {-| Split a text stream in two, where the first text stream is the longest
693 consecutive group of characters that don't satisfy the predicate
699 -> Producer Text m (Producer Text m r)
700 break predicate = span (not . predicate)
701 {-# INLINABLE break #-}
703 {-| Split a text stream into sub-streams delimited by characters that satisfy the
710 -> PP.FreeT (Producer Text m) m r
711 splitWith predicate p0 = PP.FreeT (go0 p0)
716 Left r -> return (PP.Pure r)
720 else return $ PP.Free $ do
721 p'' <- span (not . predicate) (yield txt >> p')
722 return $ PP.FreeT (go1 p'')
727 Right (_, p') -> PP.Free $ do
728 p'' <- span (not . predicate) p'
729 return $ PP.FreeT (go1 p'')
730 {-# INLINABLE splitWith #-}
732 -- | Split a text stream using the given 'Char' as the delimiter
736 -> FreeT (Producer Text m) m r
737 split c = splitWith (c ==)
738 {-# INLINABLE split #-}
740 {-| Group a text stream into 'FreeT'-delimited text streams using the supplied
745 => (Char -> Char -> Bool)
747 -> FreeT (Producer Text m) m r
748 groupBy equal p0 = PP.FreeT (go p0)
753 Left r -> return (PP.Pure r)
754 Right (txt, p') -> case (T.uncons txt) of
757 return $ PP.Free $ do
758 p'' <- span (equal c) (yield txt >> p')
759 return $ PP.FreeT (go p'')
760 {-# INLINABLE groupBy #-}
762 -- | Group a text stream into 'FreeT'-delimited text streams of identical characters
764 :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
766 {-# INLINABLE group #-}
768 {-| Split a text stream into 'FreeT'-delimited lines
771 :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
772 lines p0 = PP.FreeT (go0 p0)
777 Left r -> return (PP.Pure r)
781 else return $ PP.Free $ go1 (yield txt >> p')
783 p' <- break ('\n' ==) p
784 return $ PP.FreeT (go2 p')
789 Right (_, p') -> PP.Free (go1 p')
790 {-# INLINABLE lines #-}
794 -- | Split a text stream into 'FreeT'-delimited words
796 :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
800 x <- next (p >-> dropWhile isSpace)
803 Right (bs, p') -> PP.Free $ do
804 p'' <- break isSpace (yield bs >> p')
806 {-# INLINABLE words #-}
809 -- | Intersperse a 'Char' in between the characters of the text stream
811 :: (Monad m) => Char -> Producer Text m r -> Producer Text m r
818 Right (txt, p') -> do
819 yield (T.intersperse c txt)
825 Right (txt, p') -> do
826 yield (T.singleton c)
827 yield (T.intersperse c txt)
829 {-# INLINABLE intersperse #-}
831 {-| 'intercalate' concatenates the 'FreeT'-delimited text streams after
832 interspersing a text stream in between them
836 => Producer Text m ()
837 -> FreeT (Producer Text m) m r
842 x <- lift (PP.runFreeT f)
844 PP.Pure r -> return r
849 x <- lift (PP.runFreeT f)
851 PP.Pure r -> return r
856 {-# INLINABLE intercalate #-}
858 {-| Join 'FreeT'-delimited lines into a text stream
861 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
865 x <- lift (PP.runFreeT f)
867 PP.Pure r -> return r
870 yield $ T.singleton '\n'
872 {-# INLINABLE unlines #-}
874 {-| Join 'FreeT'-delimited words into a text stream
877 :: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
878 unwords = intercalate (yield $ T.pack " ")
879 {-# INLINABLE unwords #-}
882 The following parsing utilities are single-character analogs of the ones found
887 @Pipes.Text.Parse@ re-exports 'nextChar', 'drawChar', 'unDrawChar', 'peekChar', and 'isEndOfChars'.
889 @Data.Text@ re-exports the 'Text' type.
891 @Pipes.Parse@ re-exports 'input', 'concat', and 'FreeT' (the type).