{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,
UnliftedFFITypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
module Data.Text.Encoding
(
decodeASCII
, decodeLatin1
, decodeUtf8
, decodeUtf16LE
, decodeUtf16BE
, decodeUtf32LE
, decodeUtf32BE
, decodeUtf8'
, decodeUtf8With
, decodeUtf16LEWith
, decodeUtf16BEWith
, decodeUtf32LEWith
, decodeUtf32BEWith
, streamDecodeUtf8
, streamDecodeUtf8With
, Decoding(..)
, encodeUtf8
, encodeUtf16LE
, encodeUtf16BE
, encodeUtf32LE
, encodeUtf32BE
, encodeUtf8Builder
, encodeUtf8BuilderEscaped
) where
import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))
import Control.Monad.ST (runST)
import Data.Bits ((.&.))
import Data.ByteString as B
import qualified Data.ByteString.Internal as B
import Data.Foldable (traverse_)
import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
import Data.Text.Internal (Text(..), safe, text)
import Data.Text.Internal.Functions
import Data.Text.Internal.Private (runText)
import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
import Data.Text.Internal.Unsafe.Shift (shiftR)
import Data.Text.Show ()
import Data.Text.Unsafe (unsafeDupablePerformIO)
import Data.Word (Word8, Word16, Word32)
import Foreign.C.Types (CSize(CSize))
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
import Foreign.Storable (Storable, peek, poke)
import GHC.Base (ByteArray#, MutableByteArray#)
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.Text.Array as A
import qualified Data.Text.Internal.Encoding.Fusion as E
import qualified Data.Text.Internal.Encoding.Utf16 as U16
import qualified Data.Text.Internal.Fusion as F
import Data.Text.Internal.ByteStringCompat
#if defined(ASSERTS)
import GHC.Stack (HasCallStack)
#endif
#include "text_cbits.h"
decodeASCII :: ByteString -> Text
decodeASCII :: ByteString -> Text
decodeASCII = ByteString -> Text
decodeUtf8
{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}
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 ForeignPtr Word8 -> Int -> Text
aux where
aux :: ForeignPtr Word8 -> Int -> Text
aux ForeignPtr Word8
fp Int
len = Array -> Int -> Int -> Text
text Array
a Int
0 Int
len
where
a :: Array
a = (forall s. ST s (MArray s)) -> Array
A.run (forall s. Int -> ST s (MArray s)
A.new Int
len forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a s. IO a -> ST s a
unsafeIOToST forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {s}. MArray s -> IO (MArray s)
go)
go :: MArray s -> IO (MArray s)
go MArray s
dest = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
forall s. MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
c_decode_latin1 (forall s. MArray s -> MutableByteArray# s
A.maBA MArray s
dest) Ptr Word8
ptr (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s
dest
decodeUtf8With ::
#if defined(ASSERTS)
HasCallStack =>
#endif
OnDecodeError -> ByteString -> Text
decodeUtf8With :: OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
onErr ByteString
bs = forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
bs ForeignPtr Word8 -> Int -> Text
aux
where
aux :: ForeignPtr Word8 -> Int -> Text
aux ForeignPtr Word8
fp Int
len = (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
runText forall a b. (a -> b) -> a -> b
$ \MArray s -> Int -> ST s Text
done -> do
let go :: MArray s -> IO Text
go MArray s
dest = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (CSize
0::CSize) forall a b. (a -> b) -> a -> b
$ \Ptr CSize
destOffPtr -> do
let end :: Ptr b
end = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
loop :: Ptr Word8 -> IO Text
loop Ptr Word8
curPtr = do
Ptr Word8
curPtr' <- forall s.
MutableByteArray# s
-> Ptr CSize -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
c_decode_utf8 (forall s. MArray s -> MutableByteArray# s
A.maBA MArray s
dest) Ptr CSize
destOffPtr Ptr Word8
curPtr forall {b}. Ptr b
end
if Ptr Word8
curPtr' forall a. Eq a => a -> a -> Bool
== forall {b}. Ptr b
end
then do
CSize
n <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
destOffPtr
forall s a. ST s a -> IO a
unsafeSTToIO (MArray s -> Int -> ST s Text
done MArray s
dest (CSize -> Int
cSizeToInt CSize
n))
else do
Word8
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
curPtr'
case OnDecodeError
onErr String
desc (forall a. a -> Maybe a
Just Word8
x) of
Maybe Char
Nothing -> Ptr Word8 -> IO Text
loop forall a b. (a -> b) -> a -> b
$ Ptr Word8
curPtr' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
Just Char
c
| Char
c forall a. Ord a => a -> a -> Bool
> Char
'\xFFFF' -> forall {a}. IO a
throwUnsupportedReplChar
| Bool
otherwise -> do
CSize
destOff <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
destOffPtr
Int
w <- forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
dest (CSize -> Int
cSizeToInt CSize
destOff)
(Char -> Char
safe Char
c)
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
destOffPtr (CSize
destOff forall a. Num a => a -> a -> a
+ Int -> CSize
intToCSize Int
w)
Ptr Word8 -> IO Text
loop forall a b. (a -> b) -> a -> b
$ Ptr Word8
curPtr' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
Ptr Word8 -> IO Text
loop Ptr Word8
ptr
(forall a s. IO a -> ST s a
unsafeIOToST forall b c a. (b -> c) -> (a -> b) -> a -> c
. MArray s -> IO Text
go) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Int -> ST s (MArray s)
A.new Int
len
where
desc :: String
desc = String
"Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
throwUnsupportedReplChar :: IO a
throwUnsupportedReplChar = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
String -> ErrorCall
ErrorCall String
"decodeUtf8With: non-BMP replacement characters not supported"
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
$
String -> ShowS
showString String
"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
.
String -> ShowS
showString String
" _"
where prec :: Int
prec = Int
10; prec' :: Int
prec' = Int
prec forall a. Num a => a -> a -> a
+ Int
1
newtype CodePoint = CodePoint Word32 deriving (CodePoint -> CodePoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodePoint -> CodePoint -> Bool
$c/= :: CodePoint -> CodePoint -> Bool
== :: CodePoint -> CodePoint -> Bool
$c== :: CodePoint -> CodePoint -> Bool
Eq, Int -> CodePoint -> ShowS
[CodePoint] -> ShowS
CodePoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodePoint] -> ShowS
$cshowList :: [CodePoint] -> ShowS
show :: CodePoint -> String
$cshow :: CodePoint -> String
showsPrec :: Int -> CodePoint -> ShowS
$cshowsPrec :: Int -> CodePoint -> ShowS
Show, Integer -> CodePoint
CodePoint -> CodePoint
CodePoint -> CodePoint -> CodePoint
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CodePoint
$cfromInteger :: Integer -> CodePoint
signum :: CodePoint -> CodePoint
$csignum :: CodePoint -> CodePoint
abs :: CodePoint -> CodePoint
$cabs :: CodePoint -> CodePoint
negate :: CodePoint -> CodePoint
$cnegate :: CodePoint -> CodePoint
* :: CodePoint -> CodePoint -> CodePoint
$c* :: CodePoint -> CodePoint -> CodePoint
- :: CodePoint -> CodePoint -> CodePoint
$c- :: CodePoint -> CodePoint -> CodePoint
+ :: CodePoint -> CodePoint -> CodePoint
$c+ :: CodePoint -> CodePoint -> CodePoint
Num, Ptr CodePoint -> IO CodePoint
Ptr CodePoint -> Int -> IO CodePoint
Ptr CodePoint -> Int -> CodePoint -> IO ()
Ptr CodePoint -> CodePoint -> IO ()
CodePoint -> Int
forall b. Ptr b -> Int -> IO CodePoint
forall b. Ptr b -> Int -> CodePoint -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr CodePoint -> CodePoint -> IO ()
$cpoke :: Ptr CodePoint -> CodePoint -> IO ()
peek :: Ptr CodePoint -> IO CodePoint
$cpeek :: Ptr CodePoint -> IO CodePoint
pokeByteOff :: forall b. Ptr b -> Int -> CodePoint -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CodePoint -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO CodePoint
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CodePoint
pokeElemOff :: Ptr CodePoint -> Int -> CodePoint -> IO ()
$cpokeElemOff :: Ptr CodePoint -> Int -> CodePoint -> IO ()
peekElemOff :: Ptr CodePoint -> Int -> IO CodePoint
$cpeekElemOff :: Ptr CodePoint -> Int -> IO CodePoint
alignment :: CodePoint -> Int
$calignment :: CodePoint -> Int
sizeOf :: CodePoint -> Int
$csizeOf :: CodePoint -> Int
Storable)
newtype DecoderState = DecoderState Word32 deriving (DecoderState -> DecoderState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecoderState -> DecoderState -> Bool
$c/= :: DecoderState -> DecoderState -> Bool
== :: DecoderState -> DecoderState -> Bool
$c== :: DecoderState -> DecoderState -> Bool
Eq, Int -> DecoderState -> ShowS
[DecoderState] -> ShowS
DecoderState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecoderState] -> ShowS
$cshowList :: [DecoderState] -> ShowS
show :: DecoderState -> String
$cshow :: DecoderState -> String
showsPrec :: Int -> DecoderState -> ShowS
$cshowsPrec :: Int -> DecoderState -> ShowS
Show, Integer -> DecoderState
DecoderState -> DecoderState
DecoderState -> DecoderState -> DecoderState
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> DecoderState
$cfromInteger :: Integer -> DecoderState
signum :: DecoderState -> DecoderState
$csignum :: DecoderState -> DecoderState
abs :: DecoderState -> DecoderState
$cabs :: DecoderState -> DecoderState
negate :: DecoderState -> DecoderState
$cnegate :: DecoderState -> DecoderState
* :: DecoderState -> DecoderState -> DecoderState
$c* :: DecoderState -> DecoderState -> DecoderState
- :: DecoderState -> DecoderState -> DecoderState
$c- :: DecoderState -> DecoderState -> DecoderState
+ :: DecoderState -> DecoderState -> DecoderState
$c+ :: DecoderState -> DecoderState -> DecoderState
Num, Ptr DecoderState -> IO DecoderState
Ptr DecoderState -> Int -> IO DecoderState
Ptr DecoderState -> Int -> DecoderState -> IO ()
Ptr DecoderState -> DecoderState -> IO ()
DecoderState -> Int
forall b. Ptr b -> Int -> IO DecoderState
forall b. Ptr b -> Int -> DecoderState -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr DecoderState -> DecoderState -> IO ()
$cpoke :: Ptr DecoderState -> DecoderState -> IO ()
peek :: Ptr DecoderState -> IO DecoderState
$cpeek :: Ptr DecoderState -> IO DecoderState
pokeByteOff :: forall b. Ptr b -> Int -> DecoderState -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DecoderState -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO DecoderState
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DecoderState
pokeElemOff :: Ptr DecoderState -> Int -> DecoderState -> IO ()
$cpokeElemOff :: Ptr DecoderState -> Int -> DecoderState -> IO ()
peekElemOff :: Ptr DecoderState -> Int -> IO DecoderState
$cpeekElemOff :: Ptr DecoderState -> Int -> IO DecoderState
alignment :: DecoderState -> Int
$calignment :: DecoderState -> Int
sizeOf :: DecoderState -> Int
$csizeOf :: DecoderState -> Int
Storable)
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 = ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding
decodeChunk ByteString
B.empty CodePoint
0 DecoderState
0
where
decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString
-> Decoding
decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding
decodeChunk ByteString
undecoded0 CodePoint
codepoint0 DecoderState
state0 ByteString
bs = forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
bs ForeignPtr Word8 -> Int -> Decoding
aux where
aux :: ForeignPtr Word8 -> Int -> Decoding
aux ForeignPtr Word8
fp Int
len = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ (forall a s. IO a -> ST s a
unsafeIOToST forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. MArray s -> IO Decoding
decodeChunkToBuffer) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Int -> ST s (MArray s)
A.new (Int
lenforall a. Num a => a -> a -> a
+Int
3)
where
decodeChunkToBuffer :: A.MArray s -> IO Decoding
decodeChunkToBuffer :: forall s. MArray s -> IO Decoding
decodeChunkToBuffer MArray s
dest = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (CSize
0::CSize) forall a b. (a -> b) -> a -> b
$ \Ptr CSize
destOffPtr ->
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CodePoint
codepoint0 forall a b. (a -> b) -> a -> b
$ \Ptr CodePoint
codepointPtr ->
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with DecoderState
state0 forall a b. (a -> b) -> a -> b
$ \Ptr DecoderState
statePtr ->
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with forall {b}. Ptr b
nullPtr forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
curPtrPtr ->
let end :: Ptr b
end = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
loop :: Ptr Word8 -> IO Decoding
loop Ptr Word8
curPtr = do
DecoderState
prevState <- forall a. Storable a => Ptr a -> IO a
peek Ptr DecoderState
statePtr
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Word8)
curPtrPtr Ptr Word8
curPtr
Ptr Word8
lastPtr <- forall s.
MutableByteArray# s
-> Ptr CSize
-> Ptr (Ptr Word8)
-> Ptr Word8
-> Ptr CodePoint
-> Ptr DecoderState
-> IO (Ptr Word8)
c_decode_utf8_with_state (forall s. MArray s -> MutableByteArray# s
A.maBA MArray s
dest) Ptr CSize
destOffPtr
Ptr (Ptr Word8)
curPtrPtr forall {b}. Ptr b
end Ptr CodePoint
codepointPtr Ptr DecoderState
statePtr
DecoderState
state <- forall a. Storable a => Ptr a -> IO a
peek Ptr DecoderState
statePtr
case DecoderState
state of
UTF8_REJECT -> do
poke statePtr 0
let skipByte x = case onErr desc (Just x) of
Nothing -> return ()
Just c -> do
destOff <- peek destOffPtr
w <- unsafeSTToIO $
unsafeWrite dest (cSizeToInt destOff) (safe c)
poke destOffPtr (destOff + intToCSize w)
if ptr == lastPtr && prevState /= UTF8_ACCEPT then do
traverse_ skipByte (B.unpack undecoded0 )
loop lastPtr
else do
peek lastPtr >>= skipByte
loop (lastPtr `plusPtr` 1)
DecoderState
_ -> do
CSize
n <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
destOffPtr
CodePoint
codepoint <- forall a. Storable a => Ptr a -> IO a
peek Ptr CodePoint
codepointPtr
Text
chunkText <- forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ do
Array
arr <- forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
dest
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 (CSize -> Int
cSizeToInt CSize
n)
let left :: Int
left = Ptr Word8
lastPtr forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr
!undecoded :: ByteString
undecoded = case DecoderState
state of
UTF8_ACCEPT -> B.empty
DecoderState
_ | Int
left forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& DecoderState
prevState forall a. Eq a => a -> a -> Bool
/= UTF8_ACCEPT -> B.append undecoded0 bs
| Bool
otherwise -> Int -> ByteString -> ByteString
B.drop Int
left ByteString
bs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> (ByteString -> Decoding) -> Decoding
Some Text
chunkText ByteString
undecoded
(ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding
decodeChunk ByteString
undecoded CodePoint
codepoint DecoderState
state)
in Ptr Word8 -> IO Decoding
loop Ptr Word8
ptr
desc :: String
desc = String
"Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"
decodeUtf8 :: ByteString -> Text
decodeUtf8 :: ByteString -> Text
decodeUtf8 = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
strictDecode
{-# INLINE[0] decodeUtf8 #-}
{-# RULES "STREAM stream/decodeUtf8 fusion" [1]
forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}
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' #-}
encodeUtf8Builder :: Text -> B.Builder
encodeUtf8Builder :: Text -> Builder
encodeUtf8Builder = BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped (forall a. FixedPrim a -> BoundedPrim a
BP.liftFixedToBounded FixedPrim Word8
BP.word8)
{-# 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
`div` 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 = case Array -> Int -> Word16
A.unsafeIndex Array
arr Int
i of
Word16
w | Word16
w forall a. Ord a => a -> a -> Bool
<= Word16
0x7F -> do
forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
BP.runB BoundedPrim Word8
be (Word16 -> Word8
word16ToWord8 Word16
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)
| Word16
w forall a. Ord a => a -> a -> Bool
<= Word16
0x7FF -> do
forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
0 forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
6) forall a. Num a => a -> a -> a
+ Word16
0xC0
forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
1 forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. Bits a => a -> a -> a
.&. Word16
0x3f) forall a. Num a => a -> a -> a
+ Word16
0x80
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
2)
| Word16
0xD800 forall a. Ord a => a -> a -> Bool
<= Word16
w Bool -> Bool -> Bool
&& Word16
w forall a. Ord a => a -> a -> Bool
<= Word16
0xDBFF -> do
let c :: Int
c = Char -> Int
ord forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> Char
U16.chr2 Word16
w (Array -> Int -> Word16
A.unsafeIndex Array
arr (Int
iforall a. Num a => a -> a -> a
+Int
1))
forall a. Integral a => Int -> a -> IO ()
poke8 @Int Int
0 forall a b. (a -> b) -> a -> b
$ (Int
c forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
18) forall a. Num a => a -> a -> a
+ Int
0xF0
forall a. Integral a => Int -> a -> IO ()
poke8 @Int Int
1 forall a b. (a -> b) -> a -> b
$ ((Int
c forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
forall a. Integral a => Int -> a -> IO ()
poke8 @Int Int
2 forall a b. (a -> b) -> a -> b
$ ((Int
c forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
forall a. Integral a => Int -> a -> IO ()
poke8 @Int Int
3 forall a b. (a -> b) -> a -> b
$ (Int
c forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
Int -> Ptr Word8 -> IO (BuildSignal a)
go (Int
i forall a. Num a => a -> a -> a
+ Int
2) (Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4)
| Bool
otherwise -> do
forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
0 forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
12) forall a. Num a => a -> a -> a
+ Word16
0xE0
forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
1 forall a b. (a -> b) -> a -> b
$ ((Word16
w forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word16
0x3F) forall a. Num a => a -> a -> a
+ Word16
0x80
forall a. Integral a => Int -> a -> IO ()
poke8 @Word16 Int
2 forall a b. (a -> b) -> a -> b
$ (Word16
w forall a. Bits a => a -> a -> a
.&. Word16
0x3F) forall a. Num a => a -> a -> a
+ Word16
0x80
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
3)
| Bool
otherwise =
Int -> BufferRange -> IO (BuildSignal a)
outerLoop Int
i (Ptr Word8 -> Ptr Word8 -> BufferRange
B.BufferRange Ptr Word8
op Ptr Word8
ope)
where
poke8 :: Integral a => Int -> a -> IO ()
poke8 :: forall a. Integral a => Int -> a -> IO ()
poke8 Int
j a
v = forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
op forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
j) (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v :: Word8)
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
ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
B.mallocByteString (Int
lenforall a. Num a => a -> a -> a
*Int
3)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr Word8
ptr forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
destPtr -> do
Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
c_encode_utf8 Ptr (Ptr Word8)
destPtr (Array -> ByteArray#
A.aBA Array
arr) (Int -> CSize
intToCSize Int
off) (Int -> CSize
intToCSize Int
len)
Ptr Word8
newDest <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
destPtr
let utf8len :: Int
utf8len = Ptr Word8
newDest forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
ptr
if Int
utf8len forall a. Ord a => a -> a -> Bool
>= Int
len forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
1
then forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
fp Int
utf8len)
else do
ForeignPtr Word8
fp' <- forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
utf8len
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp' forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr' -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
ptr' Ptr Word8
ptr Int
utf8len
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
fp' Int
utf8len)
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 #-}
cSizeToInt :: CSize -> Int
cSizeToInt :: CSize -> Int
cSizeToInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
intToCSize :: Int -> CSize
intToCSize :: Int -> CSize
intToCSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral
word16ToWord8 :: Word16 -> Word8
word16ToWord8 :: Word16 -> Word8
word16ToWord8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8
:: MutableByteArray# s -> Ptr CSize
-> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state
:: MutableByteArray# s -> Ptr CSize
-> Ptr (Ptr Word8) -> Ptr Word8
-> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
:: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
:: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()