module Data.Text.Encoding
(
decodeASCII
, decodeUtf8
, decodeUtf16LE
, decodeUtf16BE
, decodeUtf32LE
, decodeUtf32BE
, decodeUtf8With
, decodeUtf16LEWith
, decodeUtf16BEWith
, decodeUtf32LEWith
, decodeUtf32BEWith
, encodeUtf8
, encodeUtf16LE
, encodeUtf16BE
, encodeUtf32LE
, encodeUtf32BE
) where
import Data.Bits ((.&.))
import Data.ByteString as B
import Data.ByteString.Internal as B
import Data.ByteString.Unsafe as B
import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
import Data.Text.Internal (Text(..), textP)
import Data.Text.UnsafeChar (ord, unsafeWrite)
import Data.Text.UnsafeShift (shiftL, shiftR)
import Data.Word (Word8)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (plusPtr)
import Foreign.Storable (poke)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Text.Array as A
import qualified Data.Text.Encoding.Fusion as E
import qualified Data.Text.Encoding.Utf16 as U16
import qualified Data.Text.Encoding.Utf8 as U8
import qualified Data.Text.Fusion as F
decodeASCII :: ByteString -> Text
decodeASCII bs = F.unstream (E.streamASCII bs)
decodeUtf8With :: OnDecodeError -> ByteString -> Text
decodeUtf8With onErr bs = textP (fst a) 0 (snd a)
where
a = A.run2 (A.new len >>= outer 0 0)
len = B.length bs
outer n0 m0 arr = go n0 m0
where
go !n !m = do
let x1 = idx m
x2 = idx (m + 1)
x3 = idx (m + 2)
x4 = idx (m + 3)
idx = B.unsafeIndex bs
case undefined of
_| m >= len -> return (arr,n)
| U8.validate1 x1 -> do
A.unsafeWrite arr n (fromIntegral x1)
go (n+1) (m+1)
| m+1 < len && U8.validate2 x1 x2 -> do
w <- unsafeWrite arr n (U8.chr2 x1 x2)
go (n+w) (m+2)
| m+2 < len && U8.validate3 x1 x2 x3 -> do
w <- unsafeWrite arr n (U8.chr3 x1 x2 x3)
go (n+w) (m+3)
| m+3 < len && U8.validate4 x1 x2 x3 x4 -> do
w <- unsafeWrite arr n (U8.chr4 x1 x2 x3 x4)
go (n+w) (m+4)
| otherwise -> case onErr desc (Just x1) of
Nothing -> go n (m+1)
Just c -> do
w <- unsafeWrite arr n c
go (n+w) (m+1)
desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
decodeUtf8 :: ByteString -> Text
decodeUtf8 = decodeUtf8With strictDecode
encodeUtf8 :: Text -> ByteString
encodeUtf8 (Text arr off len) = unsafePerformIO $ do
let size0 = min len 4
mallocByteString size0 >>= start size0 off 0
where
start size n0 m0 fp = withForeignPtr fp $ loop n0 m0
where
loop n1 m1 ptr = go n1 m1
where
go !n !m
| noff == len = return $! PS fp 0 m
| sizem < 4 = do
let newSize = size `shiftL` 1
fp' <- mallocByteString newSize
withForeignPtr fp' $ \ptr' -> memcpy ptr' ptr (fromIntegral m)
start newSize n m fp'
| otherwise = do
let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)
w = A.unsafeIndex arr n
case undefined of
_| w <= 0x7F -> do
poke8 m w
go (n+1) (m+1)
| w <= 0x7FF -> do
poke8 m $ (w `shiftR` 6) + 0xC0
poke8 (m+1) $ (w .&. 0x3f) + 0x80
go (n+1) (m+2)
| 0xD800 <= w && w <= 0xDBFF -> do
let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
poke8 m $ (c `shiftR` 18) + 0xF0
poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80
poke8 (m+3) $ (c .&. 0x3F) + 0x80
go (n+2) (m+4)
| otherwise -> do
poke8 m $ (w `shiftR` 12) + 0xE0
poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80
poke8 (m+2) $ (w .&. 0x3F) + 0x80
go (n+1) (m+3)
decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)
decodeUtf16LE :: ByteString -> Text
decodeUtf16LE = decodeUtf16LEWith strictDecode
decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)
decodeUtf16BE :: ByteString -> Text
decodeUtf16BE = decodeUtf16BEWith strictDecode
encodeUtf16LE :: Text -> ByteString
encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))
encodeUtf16BE :: Text -> ByteString
encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))
decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)
decodeUtf32LE :: ByteString -> Text
decodeUtf32LE = decodeUtf32LEWith strictDecode
decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)
decodeUtf32BE :: ByteString -> Text
decodeUtf32BE = decodeUtf32BEWith strictDecode
encodeUtf32LE :: Text -> ByteString
encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))
encodeUtf32BE :: Text -> ByteString
encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))