@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
12-- |
23-- Module : Data.Text.Encoding
34-- Copyright : (c) Tom Harper 2008-2009,
@@ -34,17 +35,29 @@ module Data.Text.Encoding
3435
3536 -- * Encoding Text to ByteStrings
3637 , encodeUtf8
38+ , encodeUtf8'
3739 , encodeUtf16LE
3840 , encodeUtf16BE
3941 , encodeUtf32LE
4042 , encodeUtf32BE
4143 ) where
4244
43−import Data.ByteString (ByteString)
44−import qualified Data.Text.Fusion as F
45+import Data.Bits ((.&.))
46+import Data.ByteString as B
47+import Data.ByteString.Internal as B
4548import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
49+import Data.Text.Encoding.Utf16 (chr2)
50+import Data.Text.Internal (Text(..))
51+import Data.Text.UnsafeChar (ord)
52+import Data.Text.UnsafeShift (shiftL, shiftR)
53+import Data.Word (Word8)
54+import Foreign.ForeignPtr (withForeignPtr)
55+import Foreign.Ptr (plusPtr)
56+import Foreign.Storable (poke)
57+import System.IO.Unsafe (unsafePerformIO)
58+import qualified Data.Text.Array as A
4659import qualified Data.Text.Encoding.Fusion as E
47−import Data.Text.Internal (Text)
60+import qualified Data.Text.Fusion as F
4861
4962-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
5063decodeASCII :: ByteString -> Text
@@ -61,10 +74,52 @@ decodeUtf8 :: ByteString -> Text
6174decodeUtf8 = decodeUtf8With strictDecode
6275{-# INLINE decodeUtf8 #-}
6376
77+-- | Encode text using UTF-8 encoding.
78+encodeUtf8' :: Text -> ByteString
79+encodeUtf8' txt = E.unstream (E.restreamUtf8 (F.stream txt))
80+{-# INLINE encodeUtf8' #-}
81+
6482-- | Encode text using UTF-8 encoding.
6583encodeUtf8 :: Text -> ByteString
66−encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))
67−{-# INLINE encodeUtf8 #-}
84+encodeUtf8 (Text arr off len) = unsafePerformIO $ do
85+ let size0 = min len 4
86+ mallocByteString size0 >>= start size0 off 0
87+ where
88+ start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
89+ where
90+ loop n1 m1 ptr = go n1 m1
91+ where
92+ go !n !m
93+ | n-off == len = return $! PS fp 0 m
94+ | size-m < 4 = {-# SCC "encodeUtf8/resize" #-} do
95+ let newSize = size `shiftL` 1
96+ fp' <- mallocByteString newSize
97+ withForeignPtr fp' $ \ptr' -> memcpy ptr' ptr (fromIntegral m)
98+ start newSize n m fp'
99+ | otherwise = do
100+ let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
101+ w = A.unsafeIndex arr n
102+ case undefined of
103+ _| w <= 0x7F -> do
104+ poke8 m w
105+ go (n+1) (m+1)
106+ | w <= 0x7FF -> do
107+ poke8 m $ (w `shiftR` 6) + 0xC0
108+ poke8 (m+1) $ (w .&. 0x3f) + 0x80
109+ go (n+1) (m+2)
110+ | 0xD800 <= w && w <= 0xDBFF -> do
111+ let c = ord $ chr2 w (A.unsafeIndex arr (n+1))
112+ poke8 m $ (c `shiftR` 18) + 0xF0
113+ poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
114+ poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
115+ poke8 (m+3) $ (c .&. 0x3F) + 0x80
116+ go (n+2) (m+4)
117+ | otherwise -> do
118+ poke8 m $ (w `shiftR` 12) + 0xE0
119+ poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
120+ poke8 (m+2) $ (w .&. 0x3F) + 0x80
121+ go (n+1) (m+3)
122+{- INLINE encodeUtf8 #-}
68123
69124-- | Decode text from little endian UTF-16 encoding.
70125decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text