@@ -17,11 +17,11 @@ module Data.Text.Lazy.Encoding.Fusion
1717 (
1818 -- * Streaming
1919 -- streamASCII
20− streamUtf8
21− --, streamUtf16LE
22− --, streamUtf16BE
23− --, streamUtf32LE
24− --, streamUtf32BE
20+ streamUtf8
21+ , streamUtf16LE
22+ , streamUtf16BE
23+ , streamUtf32LE
24+ , streamUtf32BE
2525
2626 -- * Unstreaming
2727 , unstream
@@ -36,9 +36,12 @@ import Data.Text.Encoding.Fusion.Common
3636import Data.Text.Encoding.Error
3737import Data.Text.Fusion (Step(..), Stream(..))
3838import Data.Text.Fusion.Size
39−import Data.Text.UnsafeChar (unsafeChr8)
40−import Data.Word (Word8)
39+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
40+import Data.Text.UnsafeShift (shiftL)
41+import Data.Word (Word8, Word16, Word32)
4142import qualified Data.Text.Encoding.Utf8 as U8
43+import qualified Data.Text.Encoding.Utf16 as U16
44+import qualified Data.Text.Encoding.Utf32 as U32
4245import System.IO.Unsafe (unsafePerformIO)
4346import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
4447import Foreign.Storable (pokeByteOff)
@@ -98,6 +101,174 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
98101 consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st
99102{-# INLINE [0] streamUtf8 #-}
100103
104+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
105+-- endian UTF-16 encoding.
106+streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
107+streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
108+ where
109+ next (T bs@(Chunk ps _) S0 i)
110+ | i + 1 < len && U16.validate1 x1 =
111+ Yield (unsafeChr x1) (T bs S0 (i+2))
112+ | i + 3 < len && U16.validate2 x1 x2 =
113+ Yield (U16.chr2 x1 x2) (T bs S0 (i+4))
114+ where len = B.length ps
115+ x1 = c (idx i) (idx (i + 1))
116+ x2 = c (idx (i + 2)) (idx (i + 3))
117+ c w1 w2 = w1 + (w2 `shiftL` 8)
118+ idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16
119+ next st@(T bs s i) =
120+ case s of
121+ S2 w1 w2 | U16.validate1 (c w1 w2) ->
122+ Yield (unsafeChr (c w1 w2)) es
123+ S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->
124+ Yield (U16.chr2 (c w1 w2) (c w3 w4)) es
125+ _ -> consume st
126+ where es = T bs S0 i
127+ c :: Word8 -> Word8 -> Word16
128+ c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)
129+ consume (T bs@(Chunk ps rest) s i)
130+ | i >= B.length ps = consume (T rest s 0)
131+ | otherwise =
132+ case s of
133+ S0 -> next (T bs (S1 x) (i+1))
134+ S1 w1 -> next (T bs (S2 w1 x) (i+1))
135+ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
136+ S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
137+ S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)
138+ (T bs (S3 w2 w3 w4) (i+1))
139+ where x = B.unsafeIndex ps i
140+ consume (T Empty S0 _) = Done
141+ consume st = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st
142+{-# INLINE [0] streamUtf16LE #-}
143+
144+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
145+-- endian UTF-16 encoding.
146+streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
147+streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
148+ where
149+ next (T bs@(Chunk ps _) S0 i)
150+ | i + 1 < len && U16.validate1 x1 =
151+ Yield (unsafeChr x1) (T bs S0 (i+2))
152+ | i + 3 < len && U16.validate2 x1 x2 =
153+ Yield (U16.chr2 x1 x2) (T bs S0 (i+4))
154+ where len = B.length ps
155+ x1 = c (idx i) (idx (i + 1))
156+ x2 = c (idx (i + 2)) (idx (i + 3))
157+ c w1 w2 = (w1 `shiftL` 8) + w2
158+ idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16
159+ next st@(T bs s i) =
160+ case s of
161+ S2 w1 w2 | U16.validate1 (c w1 w2) ->
162+ Yield (unsafeChr (c w1 w2)) es
163+ S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->
164+ Yield (U16.chr2 (c w1 w2) (c w3 w4)) es
165+ _ -> consume st
166+ where es = T bs S0 i
167+ c :: Word8 -> Word8 -> Word16
168+ c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2
169+ consume (T bs@(Chunk ps rest) s i)
170+ | i >= B.length ps = consume (T rest s 0)
171+ | otherwise =
172+ case s of
173+ S0 -> next (T bs (S1 x) (i+1))
174+ S1 w1 -> next (T bs (S2 w1 x) (i+1))
175+ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
176+ S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
177+ S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)
178+ (T bs (S3 w2 w3 w4) (i+1))
179+ where x = B.unsafeIndex ps i
180+ consume (T Empty S0 _) = Done
181+ consume st = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st
182+{-# INLINE [0] streamUtf16BE #-}
183+
184+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
185+-- endian UTF-32 encoding.
186+streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
187+streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
188+ where
189+ next (T bs@(Chunk ps _) S0 i)
190+ | i + 3 < len && U32.validate x =
191+ Yield (unsafeChr32 x) (T bs S0 (i+4))
192+ where len = B.length ps
193+ x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
194+ x1 = idx i
195+ x2 = idx (i+1)
196+ x3 = idx (i+2)
197+ x4 = idx (i+3)
198+ idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32
199+ next st@(T bs s i) =
200+ case s of
201+ S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->
202+ Yield (unsafeChr32 (c w1 w2 w3 w4)) es
203+ _ -> consume st
204+ where es = T bs S0 i
205+ c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
206+ c w1 w2 w3 w4 = shifted
207+ where
208+ shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4
209+ x1 = fromIntegral w1
210+ x2 = fromIntegral w2
211+ x3 = fromIntegral w3
212+ x4 = fromIntegral w4
213+ consume (T bs@(Chunk ps rest) s i)
214+ | i >= B.length ps = consume (T rest s 0)
215+ | otherwise =
216+ case s of
217+ S0 -> next (T bs (S1 x) (i+1))
218+ S1 w1 -> next (T bs (S2 w1 x) (i+1))
219+ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
220+ S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
221+ S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)
222+ (T bs (S3 w2 w3 w4) (i+1))
223+ where x = B.unsafeIndex ps i
224+ consume (T Empty S0 _) = Done
225+ consume st = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st
226+{-# INLINE [0] streamUtf32BE #-}
227+
228+-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
229+-- endian UTF-32 encoding.
230+streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
231+streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
232+ where
233+ next (T bs@(Chunk ps _) S0 i)
234+ | i + 3 < len && U32.validate x =
235+ Yield (unsafeChr32 x) (T bs S0 (i+4))
236+ where len = B.length ps
237+ x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
238+ x1 = idx i
239+ x2 = idx (i+1)
240+ x3 = idx (i+2)
241+ x4 = idx (i+3)
242+ idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32
243+ next st@(T bs s i) =
244+ case s of
245+ S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->
246+ Yield (unsafeChr32 (c w1 w2 w3 w4)) es
247+ _ -> consume st
248+ where es = T bs S0 i
249+ c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
250+ c w1 w2 w3 w4 = shifted
251+ where
252+ shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1
253+ x1 = fromIntegral w1
254+ x2 = fromIntegral w2
255+ x3 = fromIntegral w3
256+ x4 = fromIntegral w4
257+ consume (T bs@(Chunk ps rest) s i)
258+ | i >= B.length ps = consume (T rest s 0)
259+ | otherwise =
260+ case s of
261+ S0 -> next (T bs (S1 x) (i+1))
262+ S1 w1 -> next (T bs (S2 w1 x) (i+1))
263+ S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))
264+ S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))
265+ S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)
266+ (T bs (S3 w2 w3 w4) (i+1))
267+ where x = B.unsafeIndex ps i
268+ consume (T Empty S0 _) = Done
269+ consume st = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st
270+{-# INLINE [0] streamUtf32LE #-}
271+
101272-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
102273unstreamChunks :: Int -> Stream Word8 -> ByteString
103274unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)