{-# 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 Control.Monad.ST (runST)
import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
import Data.Bits (shiftR, (.&.))
import Data.Word (Word8)
import Foreign.C.Types (CSize(..))
import Foreign.Ptr (Ptr, minusPtr, plusPtr)
import Foreign.Storable (poke, peekByteOff)
import GHC.Exts (byteArrayContents#, unsafeCoerce#)
import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(PlainPtr))
import Data.ByteString (ByteString)
import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode, lenientDecode)
import Data.Text.Internal (Text(..), empty)
import Data.Text.Internal.ByteStringCompat (withBS)
import Data.Text.Internal.Encoding
import Data.Text.Internal.Unsafe (unsafeWithForeignPtr)
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 #-}
asciiPrefixLength :: ByteString -> Int
asciiPrefixLength :: ByteString -> Int
asciiPrefixLength ByteString
bs = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
bs forall a b. (a -> b) -> a -> b
$ \ ForeignPtr Word8
fp Int
len ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> do
forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Ptr Word8 -> IO CSize
c_is_ascii Ptr Word8
src (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)
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 forall a. a -> Maybe a
Just Text
prefix else 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 forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
suffix in
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"decodeASCII: detected non-ASCII codepoint " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
word forall a. [a] -> [a] -> [a]
++ [Char]
" at position " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
errPos
decodeLatin1 ::
#if defined(ASSERTS)
HasCallStack =>
#endif
ByteString -> Text
decodeLatin1 :: ByteString -> Text
decodeLatin1 ByteString
bs = forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
bs forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp Int
len -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MArray s
dst <- forall s. Int -> ST s (MArray s)
A.new (Int
2 forall a. Num a => a -> a -> a
* Int
len)
let inner :: Int -> Int -> ST s Int
inner Int
srcOff Int
dstOff = if Int
srcOff forall a. Ord a => a -> a -> Bool
>= Int
len then forall (m :: * -> *) a. Monad m => a -> m a
return Int
dstOff else do
Int
asciiPrefixLen <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src ->
Ptr Word8 -> Ptr Word8 -> IO CSize
c_is_ascii (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcOff) (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)
if Int
asciiPrefixLen forall a. Eq a => a -> a -> Bool
== Int
0
then do
Word8
byte <- forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
srcOff
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst Int
dstOff (Word8
0xC0 forall a. Num a => a -> a -> a
+ (Word8
byte forall a. Bits a => a -> Int -> a
`shiftR` Int
6))
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dst (Int
dstOff forall a. Num a => a -> a -> a
+ Int
1) (Word8
0x80 forall a. Num a => a -> a -> a
+ (Word8
byte forall a. Bits a => a -> a -> a
.&. Word8
0x3F))
Int -> Int -> ST s Int
inner (Int
srcOff forall a. Num a => a -> a -> a
+ Int
1) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
2)
else do
forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src ->
forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ forall s. MArray s -> Int -> Ptr Word8 -> Int -> ST s ()
A.copyFromPointer MArray s
dst Int
dstOff (Ptr Word8
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcOff) Int
asciiPrefixLen
Int -> Int -> ST s Int
inner (Int
srcOff forall a. Num a => a -> a -> a
+ Int
asciiPrefixLen) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
asciiPrefixLen)
Int
actualLen <- Int -> Int -> ST s Int
inner Int
0 Int
0
MArray s
dst' <- forall s. MArray s -> Int -> ST s (MArray s)
A.resizeM MArray s
dst Int
actualLen
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dst'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
actualLen
foreign import ccall unsafe "_hs_text_is_ascii" c_is_ascii
:: Ptr Word8 -> Ptr Word8 -> IO CSize
data Decoding = Some !Text !ByteString (ByteString -> Decoding)
instance Show Decoding where
showsPrec :: Int -> Decoding -> ShowS
showsPrec Int
d (Some Text
t ByteString
bs ByteString -> Decoding
_) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
prec) forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString [Char]
"Some " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec' Text
t forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec' ByteString
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> ShowS
showString [Char]
" _"
where prec :: Int
prec = Int
10; prec' :: Int
prec' = Int
prec 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' = forall a. IO a -> a
unsafeDupablePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO a
evaluate 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 (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)
| forall {b}. Ptr b
op' forall a. Ord a => a -> a -> Bool
<= Ptr Word8
ope = do
forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ 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 forall {b}. Ptr b
op' Ptr Word8
ope)
| Bool
otherwise = 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 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 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 forall a. Ord a => a -> a -> Bool
<= Int
outRemaining = do
forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ 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 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
inpRemaining) Ptr Word8
ope
BuildStep a
k BufferRange
br
| Bool
otherwise = do
forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ 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 forall a. Num a => a -> a -> a
+ Int
outRemaining
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op
inpRemaining :: Int
inpRemaining = Int
ipe 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 (forall {a}.
Text
-> (BufferRange -> IO (BuildSignal a))
-> BufferRange
-> IO (BuildSignal a)
mkBuildstep Text
txt)
where
bound :: Int
bound = forall a. Ord a => a -> a -> a
max Int
4 forall a b. (a -> b) -> a -> b
$ 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 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 forall a. Ord a => a -> a -> Bool
>= Int
iend = BufferRange -> IO (BuildSignal a)
k BufferRange
br
| Int
outRemaining forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> IO (BuildSignal a)
goPartial (Int
i0 forall a. Num a => a -> a -> a
+ forall a. Ord a => a -> a -> a
min Int
outRemaining Int
inpRemaining)
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
op0) forall a. Integral a => a -> a -> a
`quot` Int
bound
inpRemaining :: Int
inpRemaining = Int
iend 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 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 forall a. Ord a => a -> a -> Bool
< Word8
0x80
then forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
BP.runB BoundedPrim Word8
be Word8
w Ptr Word8
op forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
else forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
op Word8
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8
op 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 forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
B.empty
| Bool
otherwise = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
marr :: MArray RealWorld
marr@(A.MutableByteArray MutableByteArray# RealWorld
mba) <- forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ forall s. Int -> ST s (MArray s)
A.newPinned Int
len
forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
len MArray RealWorld
marr Int
0 Array
arr Int
off
let fp :: ForeignPtr a
fp = forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
mba))
(MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr MutableByteArray# RealWorld
mba)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
B.fromForeignPtr forall {a}. ForeignPtr a
fp Int
0 Int
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 #-}