{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
module Data.Text.Internal.Encoding.Fusion
(
streamASCII
, streamUtf8
, streamUtf16LE
, streamUtf16BE
, streamUtf32LE
, streamUtf32BE
, unstream
, module Data.Text.Internal.Encoding.Fusion.Common
) where
#if defined(ASSERTS)
import Control.Exception (assert)
#endif
import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
import Data.Text.Internal.Fusion (Step(..), Stream(..))
import Data.Text.Internal.Fusion.Size
import Data.Text.Encoding.Error
import Data.Text.Internal.Encoding.Fusion.Common
import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
import Data.Text.Internal.Functions (unsafeWithForeignPtr)
import Data.Word (Word8, Word16, Word32)
import Foreign.ForeignPtr (ForeignPtr)
import Foreign.Storable (pokeByteOff)
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.Text.Internal.Encoding.Utf8 as U8
import qualified Data.Text.Internal.Encoding.Utf16 as U16
import qualified Data.Text.Internal.Encoding.Utf32 as U32
import Data.Text.Unsafe (unsafeDupablePerformIO)
import Data.Text.Internal.ByteStringCompat
streamASCII :: ByteString -> Stream Char
streamASCII :: ByteString -> Stream Char
streamASCII ByteString
bs = forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next Int
0 (Int -> Size
maxSize Int
l)
where
l :: Int
l = ByteString -> Int
B.length ByteString
bs
{-# INLINE next #-}
next :: Int -> Step Int Char
next Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
l = forall s a. Step s a
Done
| Bool
otherwise = forall s a. a -> s -> Step s a
Yield (Word8 -> Char
unsafeChr8 Word8
x1) (Int
iforall a. Num a => a -> a -> a
+Int
1)
where
x1 :: Word8
x1 = ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs Int
i
{-# DEPRECATED streamASCII "Do not use this function" #-}
{-# INLINE [0] streamASCII #-}
streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
streamUtf8 OnDecodeError
onErr ByteString
bs = forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next Int
0 (Int -> Size
maxSize Int
l)
where
l :: Int
l = ByteString -> Int
B.length ByteString
bs
next :: Int -> Step Int Char
next Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
l = forall s a. Step s a
Done
| Word8 -> Bool
U8.validate1 Word8
x1 = forall s a. a -> s -> Step s a
Yield (Word8 -> Char
unsafeChr8 Word8
x1) (Int
iforall a. Num a => a -> a -> a
+Int
1)
| Int
iforall a. Num a => a -> a -> a
+Int
1 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word8 -> Word8 -> Bool
U8.validate2 Word8
x1 Word8
x2 = forall s a. a -> s -> Step s a
Yield (Word8 -> Word8 -> Char
U8.chr2 Word8
x1 Word8
x2) (Int
iforall a. Num a => a -> a -> a
+Int
2)
| Int
iforall a. Num a => a -> a -> a
+Int
2 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word8 -> Word8 -> Word8 -> Bool
U8.validate3 Word8
x1 Word8
x2 Word8
x3 = forall s a. a -> s -> Step s a
Yield (Word8 -> Word8 -> Word8 -> Char
U8.chr3 Word8
x1 Word8
x2 Word8
x3) (Int
iforall a. Num a => a -> a -> a
+Int
3)
| Int
iforall a. Num a => a -> a -> a
+Int
3 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word8 -> Word8 -> Word8 -> Word8 -> Bool
U8.validate4 Word8
x1 Word8
x2 Word8
x3 Word8
x4 = forall s a. a -> s -> Step s a
Yield (Word8 -> Word8 -> Word8 -> Word8 -> Char
U8.chr4 Word8
x1 Word8
x2 Word8
x3 Word8
x4) (Int
iforall a. Num a => a -> a -> a
+Int
4)
| Bool
otherwise = forall s.
String
-> String -> OnDecodeError -> Maybe Word8 -> s -> Step s Char
decodeError String
"streamUtf8" String
"UTF-8" OnDecodeError
onErr (forall a. a -> Maybe a
Just Word8
x1) (Int
iforall a. Num a => a -> a -> a
+Int
1)
where
x1 :: Word8
x1 = Int -> Word8
idx Int
i
x2 :: Word8
x2 = Int -> Word8
idx (Int
i forall a. Num a => a -> a -> a
+ Int
1)
x3 :: Word8
x3 = Int -> Word8
idx (Int
i forall a. Num a => a -> a -> a
+ Int
2)
x4 :: Word8
x4 = Int -> Word8
idx (Int
i forall a. Num a => a -> a -> a
+ Int
3)
idx :: Int -> Word8
idx = ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs
{-# INLINE [0] streamUtf8 #-}
streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
streamUtf16LE OnDecodeError
onErr ByteString
bs = forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next Int
0 (Int -> Size
maxSize (Int
l forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
1))
where
l :: Int
l = ByteString -> Int
B.length ByteString
bs
{-# INLINE next #-}
next :: Int -> Step Int Char
next Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
l = forall s a. Step s a
Done
| Int
iforall a. Num a => a -> a -> a
+Int
1 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word16 -> Bool
U16.validate1 Word16
x1 = forall s a. a -> s -> Step s a
Yield (Word16 -> Char
unsafeChr Word16
x1) (Int
iforall a. Num a => a -> a -> a
+Int
2)
| Int
iforall a. Num a => a -> a -> a
+Int
3 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word16 -> Word16 -> Bool
U16.validate2 Word16
x1 Word16
x2 = forall s a. a -> s -> Step s a
Yield (Word16 -> Word16 -> Char
U16.chr2 Word16
x1 Word16
x2) (Int
iforall a. Num a => a -> a -> a
+Int
4)
| Bool
otherwise = forall s.
String
-> String -> OnDecodeError -> Maybe Word8 -> s -> Step s Char
decodeError String
"streamUtf16LE" String
"UTF-16LE" OnDecodeError
onErr forall a. Maybe a
Nothing (Int
iforall a. Num a => a -> a -> a
+Int
1)
where
x1 :: Word16
x1 = Int -> Word16
idx Int
i forall a. Num a => a -> a -> a
+ (Int -> Word16
idx (Int
i forall a. Num a => a -> a -> a
+ Int
1) forall a. UnsafeShift a => a -> Int -> a
`shiftL` Int
8)
x2 :: Word16
x2 = Int -> Word16
idx (Int
i forall a. Num a => a -> a -> a
+ Int
2) forall a. Num a => a -> a -> a
+ (Int -> Word16
idx (Int
i forall a. Num a => a -> a -> a
+ Int
3) forall a. UnsafeShift a => a -> Int -> a
`shiftL` Int
8)
idx :: Int -> Word16
idx = Word8 -> Word16
word8ToWord16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs :: Int -> Word16
{-# INLINE [0] streamUtf16LE #-}
streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
streamUtf16BE OnDecodeError
onErr ByteString
bs = forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next Int
0 (Int -> Size
maxSize (Int
l forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
1))
where
l :: Int
l = ByteString -> Int
B.length ByteString
bs
{-# INLINE next #-}
next :: Int -> Step Int Char
next Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
l = forall s a. Step s a
Done
| Int
iforall a. Num a => a -> a -> a
+Int
1 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word16 -> Bool
U16.validate1 Word16
x1 = forall s a. a -> s -> Step s a
Yield (Word16 -> Char
unsafeChr Word16
x1) (Int
iforall a. Num a => a -> a -> a
+Int
2)
| Int
iforall a. Num a => a -> a -> a
+Int
3 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word16 -> Word16 -> Bool
U16.validate2 Word16
x1 Word16
x2 = forall s a. a -> s -> Step s a
Yield (Word16 -> Word16 -> Char
U16.chr2 Word16
x1 Word16
x2) (Int
iforall a. Num a => a -> a -> a
+Int
4)
| Bool
otherwise = forall s.
String
-> String -> OnDecodeError -> Maybe Word8 -> s -> Step s Char
decodeError String
"streamUtf16BE" String
"UTF-16BE" OnDecodeError
onErr forall a. Maybe a
Nothing (Int
iforall a. Num a => a -> a -> a
+Int
1)
where
x1 :: Word16
x1 = (Int -> Word16
idx Int
i forall a. UnsafeShift a => a -> Int -> a
`shiftL` Int
8) forall a. Num a => a -> a -> a
+ Int -> Word16
idx (Int
i forall a. Num a => a -> a -> a
+ Int
1)
x2 :: Word16
x2 = (Int -> Word16
idx (Int
i forall a. Num a => a -> a -> a
+ Int
2) forall a. UnsafeShift a => a -> Int -> a
`shiftL` Int
8) forall a. Num a => a -> a -> a
+ Int -> Word16
idx (Int
i forall a. Num a => a -> a -> a
+ Int
3)
idx :: Int -> Word16
idx = Word8 -> Word16
word8ToWord16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs :: Int -> Word16
{-# INLINE [0] streamUtf16BE #-}
streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
streamUtf32BE OnDecodeError
onErr ByteString
bs = forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next Int
0 (Int -> Size
maxSize (Int
l forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
2))
where
l :: Int
l = ByteString -> Int
B.length ByteString
bs
{-# INLINE next #-}
next :: Int -> Step Int Char
next Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
l = forall s a. Step s a
Done
| Int
iforall a. Num a => a -> a -> a
+Int
3 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word32 -> Bool
U32.validate Word32
x = forall s a. a -> s -> Step s a
Yield (Word32 -> Char
unsafeChr32 Word32
x) (Int
iforall a. Num a => a -> a -> a
+Int
4)
| Bool
otherwise = forall s.
String
-> String -> OnDecodeError -> Maybe Word8 -> s -> Step s Char
decodeError String
"streamUtf32BE" String
"UTF-32BE" OnDecodeError
onErr forall a. Maybe a
Nothing (Int
iforall a. Num a => a -> a -> a
+Int
1)
where
x :: Word32
x = forall a. UnsafeShift a => a -> Int -> a
shiftL Word32
x1 Int
24 forall a. Num a => a -> a -> a
+ forall a. UnsafeShift a => a -> Int -> a
shiftL Word32
x2 Int
16 forall a. Num a => a -> a -> a
+ forall a. UnsafeShift a => a -> Int -> a
shiftL Word32
x3 Int
8 forall a. Num a => a -> a -> a
+ Word32
x4
x1 :: Word32
x1 = Int -> Word32
idx Int
i
x2 :: Word32
x2 = Int -> Word32
idx (Int
iforall a. Num a => a -> a -> a
+Int
1)
x3 :: Word32
x3 = Int -> Word32
idx (Int
iforall a. Num a => a -> a -> a
+Int
2)
x4 :: Word32
x4 = Int -> Word32
idx (Int
iforall a. Num a => a -> a -> a
+Int
3)
idx :: Int -> Word32
idx = Word8 -> Word32
word8ToWord32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs :: Int -> Word32
{-# INLINE [0] streamUtf32BE #-}
streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
streamUtf32LE OnDecodeError
onErr ByteString
bs = forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int Char
next Int
0 (Int -> Size
maxSize (Int
l forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
2))
where
l :: Int
l = ByteString -> Int
B.length ByteString
bs
{-# INLINE next #-}
next :: Int -> Step Int Char
next Int
i
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
l = forall s a. Step s a
Done
| Int
iforall a. Num a => a -> a -> a
+Int
3 forall a. Ord a => a -> a -> Bool
< Int
l Bool -> Bool -> Bool
&& Word32 -> Bool
U32.validate Word32
x = forall s a. a -> s -> Step s a
Yield (Word32 -> Char
unsafeChr32 Word32
x) (Int
iforall a. Num a => a -> a -> a
+Int
4)
| Bool
otherwise = forall s.
String
-> String -> OnDecodeError -> Maybe Word8 -> s -> Step s Char
decodeError String
"streamUtf32LE" String
"UTF-32LE" OnDecodeError
onErr forall a. Maybe a
Nothing (Int
iforall a. Num a => a -> a -> a
+Int
1)
where
x :: Word32
x = forall a. UnsafeShift a => a -> Int -> a
shiftL Word32
x4 Int
24 forall a. Num a => a -> a -> a
+ forall a. UnsafeShift a => a -> Int -> a
shiftL Word32
x3 Int
16 forall a. Num a => a -> a -> a
+ forall a. UnsafeShift a => a -> Int -> a
shiftL Word32
x2 Int
8 forall a. Num a => a -> a -> a
+ Word32
x1
x1 :: Word32
x1 = Int -> Word32
idx Int
i
x2 :: Word32
x2 = Int -> Word32
idx forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
1
x3 :: Word32
x3 = Int -> Word32
idx forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
2
x4 :: Word32
x4 = Int -> Word32
idx forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
3
idx :: Int -> Word32
idx = Word8 -> Word32
word8ToWord32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
B.unsafeIndex ByteString
bs :: Int -> Word32
{-# INLINE [0] streamUtf32LE #-}
unstream :: Stream Word8 -> ByteString
unstream :: Stream Word8 -> ByteString
unstream (Stream s -> Step s Word8
next s
s0 Size
len) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
let mlen :: Int
mlen = Int -> Size -> Int
upperBound Int
4 Size
len
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
mlen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> s -> ForeignPtr Word8 -> IO ByteString
loop Int
mlen Int
0 s
s0
where
loop :: Int -> Int -> s -> ForeignPtr Word8 -> IO ByteString
loop !Int
n !Int
off !s
s ForeignPtr Word8
fp = case s -> Step s Word8
next s
s of
Step s Word8
Done -> forall {m :: * -> *} {p}.
Monad m =>
ForeignPtr Word8 -> p -> Int -> m ByteString
trimUp ForeignPtr Word8
fp Int
n Int
off
Skip s
s' -> Int -> Int -> s -> ForeignPtr Word8 -> IO ByteString
loop Int
n Int
off s
s' ForeignPtr Word8
fp
Yield Word8
x s
s'
| Int
off forall a. Eq a => a -> a -> Bool
== Int
n -> ForeignPtr Word8 -> Int -> Int -> s -> Word8 -> IO ByteString
realloc ForeignPtr Word8
fp Int
n Int
off s
s' Word8
x
| Bool
otherwise -> do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p Int
off Word8
x
Int -> Int -> s -> ForeignPtr Word8 -> IO ByteString
loop Int
n (Int
offforall a. Num a => a -> a -> a
+Int
1) s
s' ForeignPtr Word8
fp
{-# NOINLINE realloc #-}
realloc :: ForeignPtr Word8 -> Int -> Int -> s -> Word8 -> IO ByteString
realloc ForeignPtr Word8
fp Int
n Int
off s
s Word8
x = do
let n' :: Int
n' = Int
nforall a. Num a => a -> a -> a
+Int
n
ForeignPtr Word8
fp' <- ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
copy0 ForeignPtr Word8
fp Int
n Int
n'
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp' forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p Int
off Word8
x
Int -> Int -> s -> ForeignPtr Word8 -> IO ByteString
loop Int
n' (Int
offforall a. Num a => a -> a -> a
+Int
1) s
s ForeignPtr Word8
fp'
{-# NOINLINE trimUp #-}
trimUp :: ForeignPtr Word8 -> p -> Int -> m ByteString
trimUp ForeignPtr Word8
fp p
_ Int
off = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
fp Int
off
copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
copy0 !ForeignPtr Word8
src !Int
srcLen !Int
destLen =
#if defined(ASSERTS)
assert (srcLen <= destLen) $
#endif
do
ForeignPtr Word8
dest <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
destLen
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
src forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src' ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
dest forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dest' ->
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dest' Ptr Word8
src' Int
srcLen
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr Word8
dest
decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8
-> s -> Step s Char
decodeError :: forall s.
String
-> String -> OnDecodeError -> Maybe Word8 -> s -> Step s Char
decodeError String
func String
kind OnDecodeError
onErr Maybe Word8
mb s
i =
case OnDecodeError
onErr String
desc Maybe Word8
mb of
Maybe Char
Nothing -> forall s a. s -> Step s a
Skip s
i
Just Char
c -> forall s a. a -> s -> Step s a
Yield Char
c s
i
where desc :: String
desc = String
"Data.Text.Internal.Encoding.Fusion." forall a. [a] -> [a] -> [a]
++ String
func forall a. [a] -> [a] -> [a]
++ String
": Invalid " forall a. [a] -> [a] -> [a]
++
String
kind forall a. [a] -> [a] -> [a]
++ String
" stream"
word8ToWord16 :: Word8 -> Word16
word8ToWord16 :: Word8 -> Word16
word8ToWord16 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
word8ToWord32 :: Word8 -> Word32
word8ToWord32 :: Word8 -> Word32
word8ToWord32 = forall a b. (Integral a, Num b) => a -> b
fromIntegral