11{-# LANGUAGE CPP #-}
22
3+ -- | Efficient interoperability between
4+ -- <https://hackage.haskell.org/package/streamly streamly> arrays and
5+ -- <https://hackage.haskell.org/package/text text>.
6+ --
7+ -- The lazy 'Text' type is equivalent to a UTF-8 encoded stream of 'Array
8+ -- Word8' in streamly. A 'Char' stream can be converted to a UTF-8 encoded
9+ -- 'Word8' stream using 'Streamly.Unicode.Stream.encodeUtf8', which in turn can
10+ -- be written as 'Array' 'Word8'. A stream of UTF-8 encoded 'Word8' or 'Array'
11+ -- 'Word8' can be decoded using 'Streamly.Unicode.Stream.decodeUtf8' or
12+ -- 'Streamly.Unicode.Stream.decodeUtf8Chunks', respectively.
13+ --
14+ -- This module provides zero-overhead conversion between lazy 'Text' and
15+ -- streamly’s 'Array Word8' or 'Word8' streams.
16+
317module Streamly.Compat.Text.Lazy
4- ( chunkReader
5- , reader
18+ (
19+ -- * Construction
20+ unsafeFromChunksIO
21+ , unsafeFromChunks
622
23+ -- * Elimination
24+ , reader
725 , toChunks
8- , unsafeFromChunks
9- , unsafeFromChunksIO
26+ , chunkReader
1027 )
1128where
1229
@@ -33,7 +50,7 @@ import Prelude hiding (read)
3350#define UNFOLD_EACH Unfold.many
3451#endif
3552
36- -- | Unfold a lazy 'Text' to a stream of 'Array' 'Words '.
53+ -- | Unfold a lazy 'Text' to a stream of 'Array Word8 '.
3754{-# INLINE chunkReader #-}
3855chunkReader :: Monad m => Unfold m Text (Array Word8 )
3956chunkReader = Unfold step seed
@@ -42,26 +59,25 @@ chunkReader = Unfold step seed
4259 step (Chunk bs bl) = return $ Yield (Strict. toArray bs) bl
4360 step Empty = return Stop
4461
45- -- | Unfold a lazy 'Text' to a stream of Word8
62+ -- | Unfold a lazy 'Text' to a stream of ' Word8'.
4663{-# INLINE reader #-}
4764reader :: Monad m => Unfold m Text Word8
4865reader = UNFOLD_EACH Array. reader chunkReader
4966
5067-- XXX Should this be called readChunks?
51- -- | Convert a lazy 'Text' to a serial stream of 'Array' ' Word8'.
68+ -- | Convert a lazy 'Text' to a stream of 'Array Word8'.
5269{-# INLINE toChunks #-}
5370toChunks :: Monad m => Text -> Stream m (Array Word8 )
5471toChunks = Stream. unfold chunkReader
5572
56- -- | Convert a serial stream of 'Array' 'Word8' to a lazy 'Text'.
73+ -- | IMPORTANT NOTE: This function is lazy only for lazy monads (e.g.
74+ -- Identity). For strict monads (e.g. /IO/) it consumes the entire input before
75+ -- generating the output. For /IO/ monad use 'unsafeFromChunksIO' instead.
5776--
58- -- This function is unsafe: the caller must ensure that each 'Array' 'Word8'
59- -- element in the stream is a valid UTF-8 encoding.
77+ -- Convert a stream of 'Array' 'Word8' to a lazy 'Text'.
6078--
61- -- IMPORTANT NOTE: This function is lazy only for lazy monads
62- -- (e.g. Identity). For strict monads (e.g. /IO/) it consumes the entire input
63- -- before generating the output. For /IO/ monad please use unsafeFromChunksIO
64- -- instead.
79+ -- Unsafe because the caller must ensure that each 'Array Word8'
80+ -- in the stream is UTF-8 encoded and terminates at Char boundary.
6581--
6682-- For strict monads like /IO/ you could create a newtype wrapper to make the
6783-- monad bind operation lazy and lift the stream to that type using hoist, then
@@ -80,6 +96,7 @@ toChunks = Stream.unfold chunkReader
8096-- @
8197--
8298-- /unsafeFromChunks/ can then be used as,
99+ --
83100-- @
84101-- {-# INLINE unsafeFromChunksIO #-}
85102-- unsafeFromChunksIO :: Stream IO (Array Word8) -> IO Text
@@ -89,8 +106,11 @@ toChunks = Stream.unfold chunkReader
89106unsafeFromChunks :: Monad m => Stream m (Array Word8 ) -> m Text
90107unsafeFromChunks = Stream. foldr chunk Empty . fmap Strict. unsafeFromArray
91108
92- -- | Convert a serial stream of 'Array' ' Word8' to a lazy 'Text' in the
109+ -- | Convert a stream of 'Array Word8' to a lazy 'Text' in the
93110-- /IO/ monad.
111+ --
112+ -- Unsafe because the caller must ensure that each 'Array Word8'
113+ -- in the stream is UTF-8 encoded and terminates at Char boundary.
94114{-# INLINE unsafeFromChunksIO #-}
95115unsafeFromChunksIO :: Stream IO (Array Word8 ) -> IO Text
96116unsafeFromChunksIO =
0 commit comments