{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,
UnliftedFFITypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Text.Encoding
(
decodeLatin1
, decodeASCIIPrefix
, decodeUtf8Lenient
, decodeUtf8'
, decodeASCII'
, decodeUtf8With
, decodeUtf16LEWith
, decodeUtf16BEWith
, decodeUtf32LEWith
, decodeUtf32BEWith
, streamDecodeUtf8With
, Decoding(..)
, decodeUtf8Chunk
, decodeUtf8More
, Utf8State
, startUtf8State
, StrictBuilder
, strictBuilderToText
, textToStrictBuilder
, decodeASCII
, decodeUtf8
, decodeUtf16LE
, decodeUtf16BE
, decodeUtf32LE
, decodeUtf32BE
, streamDecodeUtf8
, encodeUtf8
, encodeUtf16LE
, encodeUtf16BE
, encodeUtf32LE
, encodeUtf32BE
, encodeUtf8Builder
, encodeUtf8BuilderEscaped
, validateUtf8Chunk
, validateUtf8More
) where
import Control.Exception (evaluate, try)
import Data.Word (Word8)
import GHC.Exts (byteArrayContents#, unsafeCoerce#)
import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(PlainPtr))
import Data.ByteString (ByteString)
#if defined(PURE_HASKELL)
import Control.Monad.ST.Unsafe (unsafeSTToIO)
import Data.ByteString.Char8 (unpack)
import Data.Text.Internal (pack)
import Foreign.Ptr (minusPtr, plusPtr)
import Foreign.Storable (poke)
#else
import Control.Monad.ST (runST)
import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
import Data.Bits (shiftR, (.&.))
import Data.Text.Internal.ByteStringCompat (withBS)
import Data.Text.Internal.Unsafe (unsafeWithForeignPtr)
import Foreign.C.Types (CSize(..))
import Foreign.Ptr (Ptr, minusPtr, plusPtr)
import Foreign.Storable (poke, peekByteOff)
#endif
import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode, lenientDecode)
import Data.Text.Internal (Text(..), empty)
import Data.Text.Internal.Encoding
import Data.Text.Internal.IsAscii (asciiPrefixLength)
import Data.Text.Unsafe (unsafeDupablePerformIO)
import Data.Text.Show ()
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)
import qualified Data.ByteString.Builder.Prim as BP
import qualified Data.ByteString.Builder.Prim.Internal as BP
import qualified Data.ByteString.Short.Internal as SBS
import qualified Data.Text.Array as A
import qualified Data.Text.Internal.Encoding.Fusion as E
import qualified Data.Text.Internal.Fusion as F
#if defined(ASSERTS)
import GHC.Stack (HasCallStack)
#endif
decodeASCIIPrefix :: ByteString -> (Text, ByteString)
decodeASCIIPrefix :: ByteString -> (Text, ByteString)
decodeASCIIPrefix ByteString
bs = if ByteString -> Bool
B.null ByteString
bs
then (Text
empty, ByteString
B.empty)
else
let len :: Int
len = ByteString -> Int
asciiPrefixLength ByteString
bs
prefix :: Text
prefix =
let !(SBS.SBS ByteArray#
arr) = ByteString -> ShortByteString
SBS.toShort (Int -> ByteString -> ByteString
B.take Int
len ByteString
bs) in
Array -> Int -> Int -> Text
Text (ByteArray# -> Array
A.ByteArray ByteArray#
arr) Int
0 Int
len
suffix :: ByteString
suffix = Int -> ByteString -> ByteString
B.drop Int
len ByteString
bs in
(Text
prefix, ByteString
suffix)
{-# INLINE decodeASCIIPrefix #-}
decodeASCII' :: ByteString -> Maybe Text
decodeASCII' :: ByteString -> Maybe Text
decodeASCII' ByteString
bs =
let (Text
prefix, ByteString
suffix) = ByteString -> (Text, ByteString)
decodeASCIIPrefix ByteString
bs in
if ByteString -> Bool
B.null ByteString
suffix then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefix else Maybe Text
forall a. Maybe a
Nothing
{-# INLINE decodeASCII' #-}
decodeASCII :: ByteString -> Text
decodeASCII :: ByteString -> Text
decodeASCII ByteString
bs =
let (Text
prefix, ByteString
suffix) = ByteString -> (Text, ByteString)
decodeASCIIPrefix ByteString
bs in
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
suffix of
Maybe (Word8, ByteString)
Nothing -> Text
prefix
Just (Word8
word, ByteString
_) ->
let !errPos :: Int
errPos = ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
suffix in
[Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"decodeASCII: detected non-ASCII codepoint " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
word [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" at position " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
errPos
decodeLatin1 ::
#if defined(ASSERTS)
HasCallStack =>
#endif
ByteString -> Text
#if defined(PURE_HASKELL)
decodeLatin1 bs = pack (Data.ByteString.Char8.unpack bs)
#else
decodeLatin1 :: ByteString -> Text
decodeLatin1 ByteString
bs = ByteString -> (ForeignPtr Word8 -> Int -> Text) -> Text
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
bs ((ForeignPtr Word8 -> Int -> Text) -> Text)
-> (ForeignPtr Word8 -> Int -> Text) -> Text
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp Int
len -> (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
dst <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len)
let inner Int
srcOff Int
dstOff = if Int
srcOff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len then Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
dstOff else do
asciiPrefixLen <- (CSize -> Int) -> ST s CSize -> ST s Int
forall a b. (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ST s CSize -> ST s Int) -> ST s CSize -> ST s Int
forall a b. (a -> b) -> a -> b
$ IO CSize -> ST s CSize
forall a s. IO a -> ST s a
unsafeIOToST (IO CSize -> ST s CSize) -> IO CSize -> ST s CSize
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO CSize) -> IO CSize
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO CSize) -> IO CSize)
-> (Ptr Word8 -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src ->
Ptr Word8 -> Ptr Word8 -> IO CSize
c_is_ascii (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcOff) (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)
if asciiPrefixLen == 0
then do
byte <- unsafeIOToST $ unsafeWithForeignPtr fp $ \Ptr Word8
src -> Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
srcOff
A.unsafeWrite dst dstOff (0xC0 + (byte `shiftR` 6))
A.unsafeWrite dst (dstOff + 1) (0x80 + (byte .&. 0x3F))
inner (srcOff + 1) (dstOff + 2)
else do
unsafeIOToST $ unsafeWithForeignPtr fp $ \Ptr Word8
src ->
ST s () -> IO ()
forall s a. ST s a -> IO a
unsafeSTToIO (ST s () -> IO ()) -> ST s () -> IO ()
forall a b. (a -> b) -> a -> b
$ MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
dst Int
dstOff (Ptr Word8
src Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcOff) Int
asciiPrefixLen
inner (srcOff + asciiPrefixLen) (dstOff + asciiPrefixLen)
actualLen <- inner 0 0
dst' <- A.resizeM dst actualLen
arr <- A.unsafeFreeze dst'
return $ Text arr 0 actualLen
#endif
#if !defined(PURE_HASKELL)
foreign import ccall unsafe "_hs_text_is_ascii" c_is_ascii
:: Ptr Word8 -> Ptr Word8 -> IO CSize
#endif
data Decoding = Some !Text !ByteString (ByteString -> Decoding)
instance Show Decoding where
showsPrec :: Int -> Decoding -> [Char] -> [Char]
showsPrec Int
d (Some Text
t ByteString
bs ByteString -> Decoding
_) = Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
prec) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> [Char] -> [Char]
showString [Char]
"Some " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
showsPrec Int
prec' Text
t ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Char -> [Char] -> [Char]
showChar Char
' ' ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
showsPrec Int
prec' ByteString
bs ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> [Char] -> [Char]
showString [Char]
" _"
where prec :: Int
prec = Int
10; prec' :: Int
prec' = Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
streamDecodeUtf8 ::
#if defined(ASSERTS)
HasCallStack =>
#endif
ByteString -> Decoding
streamDecodeUtf8 :: ByteString -> Decoding
streamDecodeUtf8 = OnDecodeError -> ByteString -> Decoding
streamDecodeUtf8With OnDecodeError
strictDecode
streamDecodeUtf8With ::
#if defined(ASSERTS)
HasCallStack =>
#endif
OnDecodeError -> ByteString -> Decoding
streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
streamDecodeUtf8With OnDecodeError
onErr = Utf8State -> ByteString -> Decoding
loop Utf8State
startUtf8State
where
loop :: Utf8State -> ByteString -> Decoding
loop Utf8State
s ByteString
chunk =
let (StrictBuilder
builder, ByteString
undecoded, Utf8State
s') = OnDecodeError
-> [Char]
-> Utf8State
-> ByteString
-> (StrictBuilder, ByteString, Utf8State)
decodeUtf8With2 OnDecodeError
onErr [Char]
invalidUtf8Msg Utf8State
s ByteString
chunk
in Text -> ByteString -> (ByteString -> Decoding) -> Decoding
Some (StrictBuilder -> Text
strictBuilderToText StrictBuilder
builder) ByteString
undecoded (Utf8State -> ByteString -> Decoding
loop Utf8State
s')
decodeUtf8With ::
#if defined(ASSERTS)
HasCallStack =>
#endif
OnDecodeError -> ByteString -> Text
decodeUtf8With :: OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
onErr = OnDecodeError -> [Char] -> ByteString -> Text
decodeUtf8With1 OnDecodeError
onErr [Char]
invalidUtf8Msg
invalidUtf8Msg :: String
invalidUtf8Msg :: [Char]
invalidUtf8Msg = [Char]
"Data.Text.Encoding: Invalid UTF-8 stream"
decodeUtf8 :: ByteString -> Text
decodeUtf8 :: ByteString -> Text
decodeUtf8 = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
strictDecode
{-# INLINE[0] decodeUtf8 #-}
decodeUtf8' ::
#if defined(ASSERTS)
HasCallStack =>
#endif
ByteString -> Either UnicodeException Text
decodeUtf8' :: ByteString -> Either UnicodeException Text
decodeUtf8' = IO (Either UnicodeException Text) -> Either UnicodeException Text
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either UnicodeException Text) -> Either UnicodeException Text)
-> (ByteString -> IO (Either UnicodeException Text))
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> IO (Either UnicodeException Text)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Text -> IO (Either UnicodeException Text))
-> (ByteString -> IO Text)
-> ByteString
-> IO (Either UnicodeException Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO Text
forall a. a -> IO a
evaluate (Text -> IO Text) -> (ByteString -> Text) -> ByteString -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
strictDecode
{-# INLINE decodeUtf8' #-}
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode
encodeUtf8Builder :: Text -> B.Builder
encodeUtf8Builder :: Text -> Builder
encodeUtf8Builder =
\Text
txt -> (forall r. BuildStep r -> BuildStep r) -> Builder
B.builder (Text
-> (BufferRange -> IO (BuildSignal r))
-> BufferRange
-> IO (BuildSignal r)
forall {a}.
Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
step Text
txt)
where
step :: Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
step txt :: Text
txt@(Text Array
arr Int
off Int
len) !BufferRange -> IO (BuildSignal a)
k br :: BufferRange
br@(B.BufferRange Ptr Word8
op Ptr Word8
ope)
| Ptr Word8
forall {b}. Ptr b
op' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope = do
ST Any () -> IO ()
forall s a. ST s a -> IO a
unsafeSTToIO (ST Any () -> IO ()) -> ST Any () -> IO ()
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Ptr Word8 -> Int -> ST Any ()
forall s. Array -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyToPointer Array
arr Int
off Ptr Word8
op Int
len
BufferRange -> IO (BuildSignal a)
k (Ptr Word8 -> Ptr Word8 -> BufferRange
B.BufferRange Ptr Word8
forall {b}. Ptr b
op' Ptr Word8
ope)
| Bool
otherwise = Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
forall {a}.
Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
textCopyStep Text
txt BufferRange -> IO (BuildSignal a)
k BufferRange
br
where
op' :: Ptr b
op' = Ptr Word8
op Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
{-# INLINE encodeUtf8Builder #-}
textCopyStep :: Text -> B.BuildStep a -> B.BuildStep a
textCopyStep :: forall {a}.
Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
textCopyStep (Text Array
arr Int
off Int
len) BuildStep a
k =
Int -> Int -> BuildStep a
go Int
off (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
where
go :: Int -> Int -> BuildStep a
go !Int
ip !Int
ipe (B.BufferRange Ptr Word8
op Ptr Word8
ope)
| Int
inpRemaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
outRemaining = do
ST Any () -> IO ()
forall s a. ST s a -> IO a
unsafeSTToIO (ST Any () -> IO ()) -> ST Any () -> IO ()
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Ptr Word8 -> Int -> ST Any ()
forall s. Array -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyToPointer Array
arr Int
ip Ptr Word8
op Int
inpRemaining
let !br :: BufferRange
br = Ptr Word8 -> Ptr Word8 -> BufferRange
B.BufferRange (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
inpRemaining) Ptr Word8
ope
BuildStep a
k BufferRange
br
| Bool
otherwise = do
ST Any () -> IO ()
forall s a. ST s a -> IO a
unsafeSTToIO (ST Any () -> IO ()) -> ST Any () -> IO ()
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Ptr Word8 -> Int -> ST Any ()
forall s. Array -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyToPointer Array
arr Int
ip Ptr Word8
op Int
outRemaining
let !ip' :: Int
ip' = Int
ip Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outRemaining
BuildSignal a -> IO (BuildSignal a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
B.bufferFull Int
1 Ptr Word8
ope (Int -> Int -> BuildStep a
go Int
ip' Int
ipe)
where
outRemaining :: Int
outRemaining = Ptr Word8
ope Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op
inpRemaining :: Int
inpRemaining = Int
ipe Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ip
{-# INLINE encodeUtf8BuilderEscaped #-}
encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
encodeUtf8BuilderEscaped :: BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped BoundedPrim Word8
be =
\Text
txt -> (forall r. BuildStep r -> BuildStep r) -> Builder
B.builder (Text
-> (BufferRange -> IO (BuildSignal r))
-> BufferRange
-> IO (BuildSignal r)
forall {a}.
Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
mkBuildstep Text
txt)
where
bound :: Int
bound = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ BoundedPrim Word8 -> Int
forall a. BoundedPrim a -> Int
BP.sizeBound BoundedPrim Word8
be
mkBuildstep :: Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
mkBuildstep (Text Array
arr Int
off Int
len) !BufferRange -> IO (BuildSignal a)
k =
Int -> BufferRange -> IO (BuildSignal a)
outerLoop Int
off
where
iend :: Int
iend = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
outerLoop :: Int -> BufferRange -> IO (BuildSignal a)
outerLoop !Int
i0 !br :: BufferRange
br@(B.BufferRange Ptr Word8
op0 Ptr Word8
ope)
| Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iend = BufferRange -> IO (BuildSignal a)
k BufferRange
br
| Int
outRemaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> IO (BuildSignal a)
goPartial (Int
i0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
outRemaining Int
inpRemaining)
| Bool
otherwise = BuildSignal a -> IO (BuildSignal a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSignal a -> IO (BuildSignal a))
-> BuildSignal a -> IO (BuildSignal a)
forall a b. (a -> b) -> a -> b
$ Int
-> Ptr Word8
-> (BufferRange -> IO (BuildSignal a))
-> BuildSignal a
forall a. Int -> Ptr Word8 -> BuildStep a -> BuildSignal a
B.bufferFull Int
bound Ptr Word8
op0 (Int -> BufferRange -> IO (BuildSignal a)
outerLoop Int
i0)
where
outRemaining :: Int
outRemaining = (Ptr Word8
ope Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op0) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
bound
inpRemaining :: Int
inpRemaining = Int
iend Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i0
goPartial :: Int -> IO (BuildSignal a)
goPartial !Int
iendTmp = Int -> Ptr Word8 -> IO (BuildSignal a)
go Int
i0 Ptr Word8
op0
where
go :: Int -> Ptr Word8 -> IO (BuildSignal a)
go !Int
i !Ptr Word8
op
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
iendTmp = do
let w :: Word8
w = Array -> Int -> Word8
A.unsafeIndex Array
arr Int
i
if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80
then BoundedPrim Word8 -> Word8 -> Ptr Word8 -> IO (Ptr Word8)
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
BP.runB BoundedPrim Word8
be Word8
w Ptr Word8
op IO (Ptr Word8)
-> (Ptr Word8 -> IO (BuildSignal a)) -> IO (BuildSignal a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
op Word8
w IO () -> IO (BuildSignal a) -> IO (BuildSignal a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
| Bool
otherwise = Int -> BufferRange -> IO (BuildSignal a)
outerLoop Int
i (Ptr Word8 -> Ptr Word8 -> BufferRange
B.BufferRange Ptr Word8
op Ptr Word8
ope)
encodeUtf8 :: Text -> ByteString
encodeUtf8 :: Text -> ByteString
encodeUtf8 (Text Array
arr Int
off Int
len)
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
B.empty
| Bool
otherwise = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
marr@(A.MutableByteArray mba) <- ST RealWorld (MArray RealWorld) -> IO (MArray RealWorld)
forall s a. ST s a -> IO a
unsafeSTToIO (ST RealWorld (MArray RealWorld) -> IO (MArray RealWorld))
-> ST RealWorld (MArray RealWorld) -> IO (MArray RealWorld)
forall a b. (a -> b) -> a -> b
$ Int -> ST RealWorld (MArray RealWorld)
forall s. Int -> ST s (MArray s)
A.newPinned Int
len
unsafeSTToIO $ A.copyI len marr 0 arr off
let fp = Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# (MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
mba))
(MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr MutableByteArray# RealWorld
mba)
pure $ B.fromForeignPtr fp 0 len
decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16LEWith OnDecodeError
onErr ByteString
bs = Stream Char -> Text
F.unstream (OnDecodeError -> ByteString -> Stream Char
E.streamUtf16LE OnDecodeError
onErr ByteString
bs)
{-# INLINE decodeUtf16LEWith #-}
decodeUtf16LE :: ByteString -> Text
decodeUtf16LE :: ByteString -> Text
decodeUtf16LE = OnDecodeError -> ByteString -> Text
decodeUtf16LEWith OnDecodeError
strictDecode
{-# INLINE decodeUtf16LE #-}
decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf16BEWith OnDecodeError
onErr ByteString
bs = Stream Char -> Text
F.unstream (OnDecodeError -> ByteString -> Stream Char
E.streamUtf16BE OnDecodeError
onErr ByteString
bs)
{-# INLINE decodeUtf16BEWith #-}
decodeUtf16BE :: ByteString -> Text
decodeUtf16BE :: ByteString -> Text
decodeUtf16BE = OnDecodeError -> ByteString -> Text
decodeUtf16BEWith OnDecodeError
strictDecode
{-# INLINE decodeUtf16BE #-}
encodeUtf16LE :: Text -> ByteString
encodeUtf16LE :: Text -> ByteString
encodeUtf16LE Text
txt = Stream Word8 -> ByteString
E.unstream (Stream Char -> Stream Word8
E.restreamUtf16LE (Text -> Stream Char
F.stream Text
txt))
{-# INLINE encodeUtf16LE #-}
encodeUtf16BE :: Text -> ByteString
encodeUtf16BE :: Text -> ByteString
encodeUtf16BE Text
txt = Stream Word8 -> ByteString
E.unstream (Stream Char -> Stream Word8
E.restreamUtf16BE (Text -> Stream Char
F.stream Text
txt))
{-# INLINE encodeUtf16BE #-}
decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32LEWith OnDecodeError
onErr ByteString
bs = Stream Char -> Text
F.unstream (OnDecodeError -> ByteString -> Stream Char
E.streamUtf32LE OnDecodeError
onErr ByteString
bs)
{-# INLINE decodeUtf32LEWith #-}
decodeUtf32LE :: ByteString -> Text
decodeUtf32LE :: ByteString -> Text
decodeUtf32LE = OnDecodeError -> ByteString -> Text
decodeUtf32LEWith OnDecodeError
strictDecode
{-# INLINE decodeUtf32LE #-}
decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text
decodeUtf32BEWith OnDecodeError
onErr ByteString
bs = Stream Char -> Text
F.unstream (OnDecodeError -> ByteString -> Stream Char
E.streamUtf32BE OnDecodeError
onErr ByteString
bs)
{-# INLINE decodeUtf32BEWith #-}
decodeUtf32BE :: ByteString -> Text
decodeUtf32BE :: ByteString -> Text
decodeUtf32BE = OnDecodeError -> ByteString -> Text
decodeUtf32BEWith OnDecodeError
strictDecode
{-# INLINE decodeUtf32BE #-}
encodeUtf32LE :: Text -> ByteString
encodeUtf32LE :: Text -> ByteString
encodeUtf32LE Text
txt = Stream Word8 -> ByteString
E.unstream (Stream Char -> Stream Word8
E.restreamUtf32LE (Text -> Stream Char
F.stream Text
txt))
{-# INLINE encodeUtf32LE #-}
encodeUtf32BE :: Text -> ByteString
encodeUtf32BE :: Text -> ByteString
encodeUtf32BE Text
txt = Stream Word8 -> ByteString
E.unstream (Stream Char -> Stream Word8
E.restreamUtf32BE (Text -> Stream Char
F.stream Text
txt))
{-# INLINE encodeUtf32BE #-}