@@ -1,7 +1,7 @@
11{-# LANGUAGE BangPatterns #-}
22
33-- |
4−-- Module : Data.Text.Encoding
4+-- Module : Data.Text.Encoding.Fusion
55-- Copyright : (c) Tom Harper 2008-2009,
66-- (c) Bryan O'Sullivan 2009,
77-- (c) Duncan Coutts 2009
@@ -28,23 +28,15 @@ module Data.Text.Encoding.Fusion
2828 -- * Unstreaming
2929 , unstream
3030
31− -- * Restreaming
32− -- Restreaming is the act of converting from one 'Stream'
33− -- representation to another.
34− , restreamUtf8
35− , restreamUtf16LE
36− , restreamUtf16BE
37− , restreamUtf32LE
38− , restreamUtf32BE
31+ , module Data.Text.Encoding.Fusion.Common
3932 ) where
4033
4134import Control.Exception (assert)
42−import Data.Bits (shiftL, shiftR, (.&.))
35+import Data.Bits (shiftL)
4336import Data.ByteString as B
4437import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
45−import Data.Char (ord)
4638import Data.Text.Fusion (Step(..), Stream(..))
47−import Data.Text.Fusion.Internal (M(..))
39+import Data.Text.Encoding.Fusion.Common
4840import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
4941import Data.Word (Word8, Word16, Word32)
5042import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
@@ -56,12 +48,6 @@ import qualified Data.Text.Encoding.Utf8 as U8
5648import qualified Data.Text.Encoding.Utf16 as U16
5749import qualified Data.Text.Encoding.Utf32 as U32
5850
59−type M8 = M Word8
60−
61−-- Restreaming state.
62−data S s = S {-# UNPACK #-} !s
63− {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8
64−
6551streamASCII :: ByteString -> Stream Char
6652streamASCII bs = Stream next 0 l
6753 where
@@ -172,129 +158,6 @@ streamUtf32LE bs = Stream next 0 l
172158 idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32
173159{-# INLINE [0] streamUtf32LE #-}
174160
175−-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.
176−restreamUtf8 :: Stream Char -> Stream Word8
177−restreamUtf8 (Stream next0 s0 len) =
178− Stream next (S s0 N N N) (len*2)
179− where
180− {-# INLINE next #-}
181− next (S s N N N) = case next0 s of
182− Done -> Done
183− Skip s' -> Skip (S s' N N N)
184− Yield x xs
185− | n <= 0x7F -> Yield c (S xs N N N)
186− | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)
187− | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)
188− | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))
189− where
190− n = ord x
191− c = fromIntegral n
192− (a2,b2) = U8.ord2 x
193− (a3,b3,c3) = U8.ord3 x
194− (a4,b4,c4,d4) = U8.ord4 x
195− next (S s (J x2) N N) = Yield x2 (S s N N N)
196− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
197− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
198− next _ = internalError "restreamUtf8"
199−{-# INLINE restreamUtf8 #-}
200−
201−restreamUtf16BE :: Stream Char -> Stream Word8
202−restreamUtf16BE (Stream next0 s0 len) =
203− Stream next (S s0 N N N) (len*2)
204− where
205− {-# INLINE next #-}
206− next (S s N N N) = case next0 s of
207− Done -> Done
208− Skip s' -> Skip (S s' N N N)
209− Yield x xs
210− | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
211− S xs (J $ fromIntegral n) N N
212− | otherwise -> Yield c1 $
213− S xs (J c2) (J c3) (J c4)
214− where
215− n = ord x
216− n1 = n - 0x10000
217− c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
218− c2 = fromIntegral (n1 `shiftR` 10)
219− n2 = n1 .&. 0x3FF
220− c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
221− c4 = fromIntegral n2
222− next (S s (J x2) N N) = Yield x2 (S s N N N)
223− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
224− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
225− next _ = internalError "restreamUtf16BE"
226−{-# INLINE restreamUtf16BE #-}
227−
228−restreamUtf16LE :: Stream Char -> Stream Word8
229−restreamUtf16LE (Stream next0 s0 len) =
230− Stream next (S s0 N N N) (len*2)
231− where
232− {-# INLINE next #-}
233− next (S s N N N) = case next0 s of
234− Done -> Done
235− Skip s' -> Skip (S s' N N N)
236− Yield x xs
237− | n < 0x10000 -> Yield (fromIntegral n) $
238− S xs (J (fromIntegral $ shiftR n 8)) N N
239− | otherwise -> Yield c1 $
240− S xs (J c2) (J c3) (J c4)
241− where
242− n = ord x
243− n1 = n - 0x10000
244− c2 = fromIntegral (shiftR n1 18 + 0xD8)
245− c1 = fromIntegral (shiftR n1 10)
246− n2 = n1 .&. 0x3FF
247− c4 = fromIntegral (shiftR n2 8 + 0xDC)
248− c3 = fromIntegral n2
249− next (S s (J x2) N N) = Yield x2 (S s N N N)
250− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
251− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
252− next _ = internalError "restreamUtf16LE"
253−{-# INLINE restreamUtf16LE #-}
254−
255−restreamUtf32BE :: Stream Char -> Stream Word8
256−restreamUtf32BE (Stream next0 s0 len) =
257− Stream next (S s0 N N N) (len*2)
258− where
259− {-# INLINE next #-}
260− next (S s N N N) = case next0 s of
261− Done -> Done
262− Skip s' -> Skip (S s' N N N)
263− Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
264− where
265− n = ord x
266− c1 = fromIntegral $ shiftR n 24
267− c2 = fromIntegral $ shiftR n 16
268− c3 = fromIntegral $ shiftR n 8
269− c4 = fromIntegral n
270− next (S s (J x2) N N) = Yield x2 (S s N N N)
271− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
272− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
273− next _ = internalError "restreamUtf32BE"
274−{-# INLINE restreamUtf32BE #-}
275−
276−restreamUtf32LE :: Stream Char -> Stream Word8
277−restreamUtf32LE (Stream next0 s0 len) =
278− Stream next (S s0 N N N) (len*2)
279− where
280− {-# INLINE next #-}
281− next (S s N N N) = case next0 s of
282− Done -> Done
283− Skip s' -> Skip (S s' N N N)
284− Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
285− where
286− n = ord x
287− c4 = fromIntegral $ shiftR n 24
288− c3 = fromIntegral $ shiftR n 16
289− c2 = fromIntegral $ shiftR n 8
290− c1 = fromIntegral n
291− next (S s (J x2) N N) = Yield x2 (S s N N N)
292− next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
293− next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
294− next _ = internalError "restreamUtf32LE"
295−{-# INLINE restreamUtf32LE #-}
296−
297−
298161-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
299162unstream :: Stream Word8 -> ByteString
300163unstream (Stream next s0 len) = unsafePerformIO $ do
@@ -325,10 +188,6 @@ unstream (Stream next s0 len) = unsafePerformIO $ do
325188 memcpy dest' src' (fromIntegral destLen)
326189 return dest
327190
328−internalError :: String -> a
329−internalError func =
330− error $ "Data.Text.Encoding.Fusion." ++ func ++ ": internal error"
331−
332191encodingError :: String -> a
333192encodingError encoding =
334193 error $ "Data.Text.Encoding.Fusion: Bad " ++ encoding ++ " stream"