{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnliftedFFITypes #-}
module Data.Streaming.Text
(
decodeUtf8
, decodeUtf8Pure
, decodeUtf16LE
, decodeUtf16BE
, decodeUtf32LE
, decodeUtf32BE
, DecodeResult (..)
) where
import Control.Monad.ST (ST, runST)
import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
import Data.Bits ((.|.), shiftL)
import qualified Data.ByteString as B
import Data.ByteString.Internal (ByteString (PS))
import qualified Data.ByteString.Unsafe as B
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Array as A
import Data.Text.Internal (text)
import qualified Data.Text.Internal.Encoding.Utf16 as U16
import qualified Data.Text.Internal.Encoding.Utf32 as U32
import qualified Data.Text.Internal.Encoding.Utf8 as U8
import Data.Text.Internal.Unsafe.Char (unsafeWrite, unsafeChr32,
unsafeChr8)
import Data.Word (Word32, Word8)
import Foreign.C.Types (CSize (..))
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr, minusPtr, nullPtr,
plusPtr)
import Foreign.Storable (Storable, peek, poke)
import GHC.Base (MutableByteArray#)
#if MIN_VERSION_text(2,0,0)
import Control.Exception (try, evaluate)
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TE
import Data.Text.Internal.Unsafe.Char (unsafeChr16)
import System.IO.Unsafe (unsafePerformIO)
#else
import Data.Text.Internal.Unsafe.Char (unsafeChr)
unsafeChr16 = unsafeChr
#endif
data S = S0
| S1 {-# UNPACK #-} !Word8
| S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
| S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
deriving Int -> S -> ShowS
[S] -> ShowS
S -> String
(Int -> S -> ShowS) -> (S -> String) -> ([S] -> ShowS) -> Show S
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S] -> ShowS
$cshowList :: [S] -> ShowS
show :: S -> String
$cshow :: S -> String
showsPrec :: Int -> S -> ShowS
$cshowsPrec :: Int -> S -> ShowS
Show
data DecodeResult
= DecodeResultSuccess !Text !(B.ByteString -> DecodeResult)
| DecodeResultFailure !Text !B.ByteString
toBS :: S -> B.ByteString
toBS :: S -> ByteString
toBS S
S0 = ByteString
B.empty
toBS (S1 Word8
a) = [Word8] -> ByteString
B.pack [Word8
a]
toBS (S2 Word8
a Word8
b) = [Word8] -> ByteString
B.pack [Word8
a, Word8
b]
toBS (S3 Word8
a Word8
b Word8
c) = [Word8] -> ByteString
B.pack [Word8
a, Word8
b, Word8
c]
{-# INLINE toBS #-}
getText :: Int -> A.MArray s -> ST s Text
getText :: Int -> MArray s -> ST s Text
getText Int
j MArray s
marr = do
Array
arr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
Text -> ST s Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$! Array -> Int -> Int -> Text
text Array
arr Int
0 Int
j
{-# INLINE getText #-}
#include "text_cbits.h"
foreign import ccall unsafe "_hs_streaming_commons_decode_utf8_state" c_decode_utf8_with_state
:: MutableByteArray# s -> Ptr CSize
-> Ptr (Ptr Word8) -> Ptr Word8
-> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)
newtype CodePoint = CodePoint Word32 deriving (CodePoint -> CodePoint -> Bool
(CodePoint -> CodePoint -> Bool)
-> (CodePoint -> CodePoint -> Bool) -> Eq CodePoint
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
(Int -> CodePoint -> ShowS)
-> (CodePoint -> String)
-> ([CodePoint] -> ShowS)
-> Show CodePoint
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
(CodePoint -> CodePoint -> CodePoint)
-> (CodePoint -> CodePoint -> CodePoint)
-> (CodePoint -> CodePoint -> CodePoint)
-> (CodePoint -> CodePoint)
-> (CodePoint -> CodePoint)
-> (CodePoint -> CodePoint)
-> (Integer -> CodePoint)
-> Num 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 b -> Int -> IO CodePoint
Ptr b -> Int -> CodePoint -> IO ()
Ptr CodePoint -> IO CodePoint
Ptr CodePoint -> Int -> IO CodePoint
Ptr CodePoint -> Int -> CodePoint -> IO ()
Ptr CodePoint -> CodePoint -> IO ()
CodePoint -> Int
(CodePoint -> Int)
-> (CodePoint -> Int)
-> (Ptr CodePoint -> Int -> IO CodePoint)
-> (Ptr CodePoint -> Int -> CodePoint -> IO ())
-> (forall b. Ptr b -> Int -> IO CodePoint)
-> (forall b. Ptr b -> Int -> CodePoint -> IO ())
-> (Ptr CodePoint -> IO CodePoint)
-> (Ptr CodePoint -> CodePoint -> IO ())
-> Storable CodePoint
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 :: Ptr b -> Int -> CodePoint -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CodePoint -> IO ()
peekByteOff :: 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
(DecoderState -> DecoderState -> Bool)
-> (DecoderState -> DecoderState -> Bool) -> Eq DecoderState
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
(Int -> DecoderState -> ShowS)
-> (DecoderState -> String)
-> ([DecoderState] -> ShowS)
-> Show DecoderState
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
(DecoderState -> DecoderState -> DecoderState)
-> (DecoderState -> DecoderState -> DecoderState)
-> (DecoderState -> DecoderState -> DecoderState)
-> (DecoderState -> DecoderState)
-> (DecoderState -> DecoderState)
-> (DecoderState -> DecoderState)
-> (Integer -> DecoderState)
-> Num 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 b -> Int -> IO DecoderState
Ptr b -> Int -> DecoderState -> IO ()
Ptr DecoderState -> IO DecoderState
Ptr DecoderState -> Int -> IO DecoderState
Ptr DecoderState -> Int -> DecoderState -> IO ()
Ptr DecoderState -> DecoderState -> IO ()
DecoderState -> Int
(DecoderState -> Int)
-> (DecoderState -> Int)
-> (Ptr DecoderState -> Int -> IO DecoderState)
-> (Ptr DecoderState -> Int -> DecoderState -> IO ())
-> (forall b. Ptr b -> Int -> IO DecoderState)
-> (forall b. Ptr b -> Int -> DecoderState -> IO ())
-> (Ptr DecoderState -> IO DecoderState)
-> (Ptr DecoderState -> DecoderState -> IO ())
-> Storable DecoderState
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 :: Ptr b -> Int -> DecoderState -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> DecoderState -> IO ()
peekByteOff :: 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)
decodeUtf8 :: B.ByteString -> DecodeResult
#if MIN_VERSION_text(2,0,0)
decodeUtf8 :: ByteString -> DecodeResult
decodeUtf8 = ByteString
-> (ByteString -> Decoding) -> ByteString -> DecodeResult
go ByteString
forall a. Monoid a => a
mempty ByteString -> Decoding
TE.streamDecodeUtf8
where
go :: B.ByteString -> (B.ByteString -> TE.Decoding) -> B.ByteString -> DecodeResult
go :: ByteString
-> (ByteString -> Decoding) -> ByteString -> DecodeResult
go ByteString
prev ByteString -> Decoding
decoder ByteString
curr = case IO (Either UnicodeException Decoding)
-> Either UnicodeException Decoding
forall a. IO a -> a
unsafePerformIO (IO Decoding -> IO (Either UnicodeException Decoding)
forall e a. Exception e => IO a -> IO (Either e a)
try (Decoding -> IO Decoding
forall a. a -> IO a
evaluate (ByteString -> Decoding
decoder ByteString
curr))) of
Left (UnicodeException
_ :: TE.UnicodeException) -> ByteString -> DecodeResult
decodeUtf8Pure (ByteString
prev ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
curr)
Right (TE.Some Text
decoded ByteString
undecoded ByteString -> Decoding
cont) -> Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
decoded (ByteString
-> (ByteString -> Decoding) -> ByteString -> DecodeResult
go ByteString
undecoded ByteString -> Decoding
cont)
#else
decodeUtf8 = decodeChunk B.empty 0 0
where
decodeChunkCheck :: B.ByteString -> CodePoint -> DecoderState -> B.ByteString -> DecodeResult
decodeChunkCheck bsOld codepoint state bs
| B.null bs =
if B.null bsOld
then DecodeResultSuccess T.empty decodeUtf8
else DecodeResultFailure T.empty bsOld
| otherwise = decodeChunk bsOld codepoint state bs
decodeChunk :: B.ByteString -> CodePoint -> DecoderState -> B.ByteString -> DecodeResult
decodeChunk bsOld codepoint0 state0 bs@(PS fp off len) =
runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
where
decodeChunkToBuffer :: A.MArray s -> IO DecodeResult
decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
with (0::CSize) $ \destOffPtr ->
with codepoint0 $ \codepointPtr ->
with state0 $ \statePtr ->
with nullPtr $ \curPtrPtr ->
let end = ptr `plusPtr` (off + len)
loop curPtr = do
poke curPtrPtr curPtr
_ <- c_decode_utf8_with_state (A.maBA dest) destOffPtr
curPtrPtr end codepointPtr statePtr
state <- peek statePtr
n <- peek destOffPtr
chunkText <- unsafeSTToIO $ do
arr <- A.unsafeFreeze dest
return $! text arr 0 (fromIntegral n)
lastPtr <- peek curPtrPtr
let left = lastPtr `minusPtr` curPtr
unused
| not $ T.null chunkText = B.unsafeDrop left bs
| B.null bsOld = bs
| otherwise = B.append bsOld bs
case unused `seq` state of
UTF8_REJECT ->
return $! DecodeResultFailure chunkText unused
_ -> do
codepoint <- peek codepointPtr
return $! DecodeResultSuccess chunkText
$! decodeChunkCheck unused codepoint state
in loop (ptr `plusPtr` off)
#endif
decodeUtf8Pure :: B.ByteString -> DecodeResult
decodeUtf8Pure :: ByteString -> DecodeResult
decodeUtf8Pure =
S -> ByteString -> DecodeResult
beginChunk S
S0
where
beginChunk :: S -> B.ByteString -> DecodeResult
beginChunk :: S -> ByteString -> DecodeResult
beginChunk S
s ByteString
bs | ByteString -> Bool
B.null ByteString
bs =
case S
s of
S
S0 -> Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
S0)
S
_ -> Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty (ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$ S -> ByteString
toBS S
s
beginChunk S
s0 ByteString
ps = (forall s. ST s DecodeResult) -> DecodeResult
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s DecodeResult) -> DecodeResult)
-> (forall s. ST s DecodeResult) -> DecodeResult
forall a b. (a -> b) -> a -> b
$ do
let initLen :: Int
initLen = ByteString -> Int
B.length ByteString
ps
#if MIN_VERSION_text(2,0,0)
MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
initLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
#else
marr <- A.new (initLen + 1)
#endif
let start :: Int -> Int -> ST s DecodeResult
start !Int
i !Int
j
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
S0)
| Word8 -> Bool
U8.validate1 Word8
a = Int -> Char -> ST s DecodeResult
addChar' Int
1 (Word8 -> Char
unsafeChr8 Word8
a)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word8 -> Word8 -> Bool
U8.validate2 Word8
a Word8
b = Int -> Char -> ST s DecodeResult
addChar' Int
2 (Word8 -> Word8 -> Char
U8.chr2 Word8
a Word8
b)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word8 -> Word8 -> Word8 -> Bool
U8.validate3 Word8
a Word8
b Word8
c = Int -> Char -> ST s DecodeResult
addChar' Int
3 (Word8 -> Word8 -> Word8 -> Char
U8.chr3 Word8
a Word8
b Word8
c)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word8 -> Word8 -> Word8 -> Word8 -> Bool
U8.validate4 Word8
a Word8
b Word8
c Word8
d = Int -> Char -> ST s DecodeResult
addChar' Int
4 (Word8 -> Word8 -> Word8 -> Word8 -> Char
U8.chr4 Word8
a Word8
b Word8
c Word8
d)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
t (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
c)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> S
S2 Word8
a Word8
b)
| Bool
otherwise = S -> ST s DecodeResult
continue (Word8 -> S
S1 Word8
a)
where
a :: Word8
a = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
b :: Word8
b = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
c :: Word8
c = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
d :: Word8
d = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
addChar' :: Int -> Char -> ST s DecodeResult
addChar' Int
deltai Char
char = do
Int
deltaj <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
char
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltai) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltaj)
continue :: S -> ST s DecodeResult
continue S
s = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont :: S -> Int -> ST s DecodeResult
checkCont S
s !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont S
s !Int
i =
case S
s of
S
S0 -> Int -> Int -> ST s DecodeResult
start Int
i Int
0
S1 Word8
a
| Word8 -> Word8 -> Bool
U8.validate2 Word8
a Word8
x -> Char -> ST s DecodeResult
addChar' (Word8 -> Word8 -> Char
U8.chr2 Word8
a Word8
x)
| Bool
otherwise -> S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> S
S2 Word8
a Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S2 Word8
a Word8
b
| Word8 -> Word8 -> Word8 -> Bool
U8.validate3 Word8
a Word8
b Word8
x -> Char -> ST s DecodeResult
addChar' (Word8 -> Word8 -> Word8 -> Char
U8.chr3 Word8
a Word8
b Word8
x)
| Bool
otherwise -> S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S3 Word8
a Word8
b Word8
c
| Word8 -> Word8 -> Word8 -> Word8 -> Bool
U8.validate4 Word8
a Word8
b Word8
c Word8
x -> Char -> ST s DecodeResult
addChar' (Word8 -> Word8 -> Word8 -> Word8 -> Char
U8.chr4 Word8
a Word8
b Word8
c Word8
x)
S
_ -> DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty
(ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
B.append (S -> ByteString
toBS S
s) (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
where
x :: Word8
x = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
addChar' :: Char -> ST s DecodeResult
addChar' Char
c = do
Int
d <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
0 Char
c
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
d
S -> Int -> ST s DecodeResult
checkCont S
s0 Int
0
where
len :: Int
len = ByteString -> Int
B.length ByteString
ps
{-# INLINE beginChunk #-}
decodeUtf16LE :: B.ByteString -> DecodeResult
decodeUtf16LE :: ByteString -> DecodeResult
decodeUtf16LE =
S -> ByteString -> DecodeResult
beginChunk S
S0
where
beginChunk :: S -> B.ByteString -> DecodeResult
beginChunk :: S -> ByteString -> DecodeResult
beginChunk S
s ByteString
bs | ByteString -> Bool
B.null ByteString
bs =
case S
s of
S
S0 -> Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
S0)
S
_ -> Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty (ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$ S -> ByteString
toBS S
s
beginChunk S
s0 ByteString
ps = (forall s. ST s DecodeResult) -> DecodeResult
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s DecodeResult) -> DecodeResult)
-> (forall s. ST s DecodeResult) -> DecodeResult
forall a b. (a -> b) -> a -> b
$ do
let initLen :: Int
initLen = ByteString -> Int
B.length ByteString
ps
#if MIN_VERSION_text(2,0,0)
MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new ((Int
initLen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
#else
marr <- A.new (initLen + 1)
#endif
let start :: Int -> Int -> ST s DecodeResult
start !Int
i !Int
j
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
S0)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word16 -> Bool
U16.validate1 Word16
x1 = Int -> Char -> ST s DecodeResult
addChar' Int
2 (Word16 -> Char
unsafeChr16 Word16
x1)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word16 -> Word16 -> Bool
U16.validate2 Word16
x1 Word16
x2 = Int -> Char -> ST s DecodeResult
addChar' Int
4 (Word16 -> Word16 -> Char
U16.chr2 Word16
x1 Word16
x2)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
t (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
c)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> S
S2 Word8
a Word8
b)
| Bool
otherwise = S -> ST s DecodeResult
continue (Word8 -> S
S1 Word8
a)
where
a :: Word8
a = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
b :: Word8
b = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
c :: Word8
c = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
d :: Word8
d = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
x1 :: Word16
x1 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
a Word8
b
x2 :: Word16
x2 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
c Word8
d
addChar' :: Int -> Char -> ST s DecodeResult
addChar' Int
deltai Char
char = do
Int
deltaj <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
char
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltai) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltaj)
continue :: S -> ST s DecodeResult
continue S
s = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont :: S -> Int -> ST s DecodeResult
checkCont S
s !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont S
s !Int
i =
case S
s of
S
S0 -> Int -> Int -> ST s DecodeResult
start Int
i Int
0
S1 Word8
a ->
let x1 :: Word16
x1 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
a Word8
x
in if Word16 -> Bool
U16.validate1 Word16
x1
then Char -> ST s DecodeResult
addChar' (Word16 -> Char
unsafeChr16 Word16
x1)
else S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> S
S2 Word8
a Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S2 Word8
a Word8
b -> S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S3 Word8
a Word8
b Word8
c ->
let x1 :: Word16
x1 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
a Word8
b
x2 :: Word16
x2 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
c Word8
x
in if Word16 -> Word16 -> Bool
U16.validate2 Word16
x1 Word16
x2
then Char -> ST s DecodeResult
addChar' (Word16 -> Word16 -> Char
U16.chr2 Word16
x1 Word16
x2)
else DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty
(ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
B.append (S -> ByteString
toBS S
s) (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
where
x :: Word8
x = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
addChar' :: Char -> ST s DecodeResult
addChar' Char
c = do
Int
d <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
0 Char
c
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
d
S -> Int -> ST s DecodeResult
checkCont S
s0 Int
0
where
len :: Int
len = ByteString -> Int
B.length ByteString
ps
combine :: a -> a -> a
combine a
w1 a
w2 = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w1 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w2 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
{-# INLINE beginChunk #-}
decodeUtf16BE :: B.ByteString -> DecodeResult
decodeUtf16BE :: ByteString -> DecodeResult
decodeUtf16BE =
S -> ByteString -> DecodeResult
beginChunk S
S0
where
beginChunk :: S -> B.ByteString -> DecodeResult
beginChunk :: S -> ByteString -> DecodeResult
beginChunk S
s ByteString
bs | ByteString -> Bool
B.null ByteString
bs =
case S
s of
S
S0 -> Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
S0)
S
_ -> Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty (ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$ S -> ByteString
toBS S
s
beginChunk S
s0 ByteString
ps = (forall s. ST s DecodeResult) -> DecodeResult
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s DecodeResult) -> DecodeResult)
-> (forall s. ST s DecodeResult) -> DecodeResult
forall a b. (a -> b) -> a -> b
$ do
let initLen :: Int
initLen = ByteString -> Int
B.length ByteString
ps
#if MIN_VERSION_text(2,0,0)
MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new ((Int
initLen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
#else
marr <- A.new (initLen + 1)
#endif
let start :: Int -> Int -> ST s DecodeResult
start !Int
i !Int
j
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
S0)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word16 -> Bool
U16.validate1 Word16
x1 = Int -> Char -> ST s DecodeResult
addChar' Int
2 (Word16 -> Char
unsafeChr16 Word16
x1)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word16 -> Word16 -> Bool
U16.validate2 Word16
x1 Word16
x2 = Int -> Char -> ST s DecodeResult
addChar' Int
4 (Word16 -> Word16 -> Char
U16.chr2 Word16
x1 Word16
x2)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
t (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
c)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> S
S2 Word8
a Word8
b)
| Bool
otherwise = S -> ST s DecodeResult
continue (Word8 -> S
S1 Word8
a)
where
a :: Word8
a = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
b :: Word8
b = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
c :: Word8
c = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
d :: Word8
d = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
x1 :: Word16
x1 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
a Word8
b
x2 :: Word16
x2 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
c Word8
d
addChar' :: Int -> Char -> ST s DecodeResult
addChar' Int
deltai Char
char = do
Int
deltaj <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
char
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltai) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltaj)
continue :: S -> ST s DecodeResult
continue S
s = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont :: S -> Int -> ST s DecodeResult
checkCont S
s !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont S
s !Int
i =
case S
s of
S
S0 -> Int -> Int -> ST s DecodeResult
start Int
i Int
0
S1 Word8
a ->
let x1 :: Word16
x1 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
a Word8
x
in if Word16 -> Bool
U16.validate1 Word16
x1
then Char -> ST s DecodeResult
addChar' (Word16 -> Char
unsafeChr16 Word16
x1)
else S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> S
S2 Word8
a Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S2 Word8
a Word8
b -> S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S3 Word8
a Word8
b Word8
c ->
let x1 :: Word16
x1 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
a Word8
b
x2 :: Word16
x2 = Word8 -> Word8 -> Word16
forall a a a.
(Bits a, Integral a, Integral a, Num a) =>
a -> a -> a
combine Word8
c Word8
x
in if Word16 -> Word16 -> Bool
U16.validate2 Word16
x1 Word16
x2
then Char -> ST s DecodeResult
addChar' (Word16 -> Word16 -> Char
U16.chr2 Word16
x1 Word16
x2)
else DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty
(ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
B.append (S -> ByteString
toBS S
s) (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
where
x :: Word8
x = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
addChar' :: Char -> ST s DecodeResult
addChar' Char
c = do
Int
d <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
0 Char
c
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
d
S -> Int -> ST s DecodeResult
checkCont S
s0 Int
0
where
len :: Int
len = ByteString -> Int
B.length ByteString
ps
combine :: a -> a -> a
combine a
w1 a
w2 = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w2
{-# INLINE beginChunk #-}
decodeUtf32LE :: B.ByteString -> DecodeResult
decodeUtf32LE :: ByteString -> DecodeResult
decodeUtf32LE =
S -> ByteString -> DecodeResult
beginChunk S
S0
where
beginChunk :: S -> B.ByteString -> DecodeResult
beginChunk :: S -> ByteString -> DecodeResult
beginChunk S
s ByteString
bs | ByteString -> Bool
B.null ByteString
bs =
case S
s of
S
S0 -> Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
S0)
S
_ -> Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty (ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$ S -> ByteString
toBS S
s
beginChunk S
s0 ByteString
ps = (forall s. ST s DecodeResult) -> DecodeResult
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s DecodeResult) -> DecodeResult)
-> (forall s. ST s DecodeResult) -> DecodeResult
forall a b. (a -> b) -> a -> b
$ do
let initLen :: Int
initLen = ByteString -> Int
B.length ByteString
ps Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
#if MIN_VERSION_text(2,0,0)
MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
initLen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
#else
marr <- A.new (initLen + 1)
#endif
let start :: Int -> Int -> ST s DecodeResult
start !Int
i !Int
j
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
S0)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word32 -> Bool
U32.validate Word32
x1 = Int -> Char -> ST s DecodeResult
addChar' Int
4 (Word32 -> Char
unsafeChr32 Word32
x1)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
t (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
c)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> S
S2 Word8
a Word8
b)
| Bool
otherwise = S -> ST s DecodeResult
continue (Word8 -> S
S1 Word8
a)
where
a :: Word8
a = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
b :: Word8
b = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
c :: Word8
c = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
d :: Word8
d = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
x1 :: Word32
x1 = Word8 -> Word8 -> Word8 -> Word8 -> Word32
forall a a a a a.
(Bits a, Integral a, Integral a, Integral a, Integral a, Num a) =>
a -> a -> a -> a -> a
combine Word8
a Word8
b Word8
c Word8
d
addChar' :: Int -> Char -> ST s DecodeResult
addChar' Int
deltai Char
char = do
Int
deltaj <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
char
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltai) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltaj)
continue :: S -> ST s DecodeResult
continue S
s = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont :: S -> Int -> ST s DecodeResult
checkCont S
s !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont S
s !Int
i =
case S
s of
S
S0 -> Int -> Int -> ST s DecodeResult
start Int
i Int
0
S1 Word8
a -> S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> S
S2 Word8
a Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S2 Word8
a Word8
b -> S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S3 Word8
a Word8
b Word8
c ->
let x1 :: Word32
x1 = Word8 -> Word8 -> Word8 -> Word8 -> Word32
forall a a a a a.
(Bits a, Integral a, Integral a, Integral a, Integral a, Num a) =>
a -> a -> a -> a -> a
combine Word8
a Word8
b Word8
c Word8
x
in if Word32 -> Bool
U32.validate Word32
x1
then Char -> ST s DecodeResult
addChar' (Word32 -> Char
unsafeChr32 Word32
x1)
else DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty
(ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
B.append (S -> ByteString
toBS S
s) (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
where
x :: Word8
x = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
addChar' :: Char -> ST s DecodeResult
addChar' Char
c = do
Int
d <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
0 Char
c
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
d
S -> Int -> ST s DecodeResult
checkCont S
s0 Int
0
where
len :: Int
len = ByteString -> Int
B.length ByteString
ps
combine :: a -> a -> a -> a -> a
combine a
w1 a
w2 a
w3 a
w4 =
a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w4) Int
24
a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w3) Int
16
a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w2) Int
8
a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w1)
{-# INLINE beginChunk #-}
decodeUtf32BE :: B.ByteString -> DecodeResult
decodeUtf32BE :: ByteString -> DecodeResult
decodeUtf32BE =
S -> ByteString -> DecodeResult
beginChunk S
S0
where
beginChunk :: S -> B.ByteString -> DecodeResult
beginChunk :: S -> ByteString -> DecodeResult
beginChunk S
s ByteString
bs | ByteString -> Bool
B.null ByteString
bs =
case S
s of
S
S0 -> Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
S0)
S
_ -> Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty (ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$ S -> ByteString
toBS S
s
beginChunk S
s0 ByteString
ps = (forall s. ST s DecodeResult) -> DecodeResult
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s DecodeResult) -> DecodeResult)
-> (forall s. ST s DecodeResult) -> DecodeResult
forall a b. (a -> b) -> a -> b
$ do
let initLen :: Int
initLen = ByteString -> Int
B.length ByteString
ps Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
#if MIN_VERSION_text(2,0,0)
MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new (Int
initLen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
#else
marr <- A.new (initLen + 1)
#endif
let start :: Int -> Int -> ST s DecodeResult
start !Int
i !Int
j
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
S0)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len Bool -> Bool -> Bool
&& Word32 -> Bool
U32.validate Word32
x1 = Int -> Char -> ST s DecodeResult
addChar' Int
4 (Word32 -> Char
unsafeChr32 Word32
x1)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
t (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
c)
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = S -> ST s DecodeResult
continue (Word8 -> Word8 -> S
S2 Word8
a Word8
b)
| Bool
otherwise = S -> ST s DecodeResult
continue (Word8 -> S
S1 Word8
a)
where
a :: Word8
a = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
b :: Word8
b = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
c :: Word8
c = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
d :: Word8
d = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
x1 :: Word32
x1 = Word8 -> Word8 -> Word8 -> Word8 -> Word32
forall a a a a a.
(Bits a, Integral a, Integral a, Integral a, Integral a, Num a) =>
a -> a -> a -> a -> a
combine Word8
a Word8
b Word8
c Word8
d
addChar' :: Int -> Char -> ST s DecodeResult
addChar' Int
deltai Char
char = do
Int
deltaj <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
j Char
char
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltai) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deltaj)
continue :: S -> ST s DecodeResult
continue S
s = do
Text
t <- Int -> MArray s -> ST s Text
forall s. Int -> MArray s -> ST s Text
getText Int
j MArray s
marr
DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
t (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont :: S -> Int -> ST s DecodeResult
checkCont S
s !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> (ByteString -> DecodeResult) -> DecodeResult
DecodeResultSuccess Text
T.empty (S -> ByteString -> DecodeResult
beginChunk S
s)
checkCont S
s !Int
i =
case S
s of
S
S0 -> Int -> Int -> ST s DecodeResult
start Int
i Int
0
S1 Word8
a -> S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> S
S2 Word8
a Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S2 Word8
a Word8
b -> S -> Int -> ST s DecodeResult
checkCont (Word8 -> Word8 -> Word8 -> S
S3 Word8
a Word8
b Word8
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
S3 Word8
a Word8
b Word8
c ->
let x1 :: Word32
x1 = Word8 -> Word8 -> Word8 -> Word8 -> Word32
forall a a a a a.
(Bits a, Integral a, Integral a, Integral a, Integral a, Num a) =>
a -> a -> a -> a -> a
combine Word8
a Word8
b Word8
c Word8
x
in if Word32 -> Bool
U32.validate Word32
x1
then Char -> ST s DecodeResult
addChar' (Word32 -> Char
unsafeChr32 Word32
x1)
else DecodeResult -> ST s DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> ST s DecodeResult)
-> DecodeResult -> ST s DecodeResult
forall a b. (a -> b) -> a -> b
$! Text -> ByteString -> DecodeResult
DecodeResultFailure Text
T.empty
(ByteString -> DecodeResult) -> ByteString -> DecodeResult
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString -> ByteString
B.append (S -> ByteString
toBS S
s) (Int -> ByteString -> ByteString
B.unsafeDrop Int
i ByteString
ps)
where
x :: Word8
x = ByteString -> Int -> Word8
B.unsafeIndex ByteString
ps Int
i
addChar' :: Char -> ST s DecodeResult
addChar' Char
c = do
Int
d <- MArray s -> Int -> Char -> ST s Int
forall s. MArray s -> Int -> Char -> ST s Int
unsafeWrite MArray s
marr Int
0 Char
c
Int -> Int -> ST s DecodeResult
start (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
d
S -> Int -> ST s DecodeResult
checkCont S
s0 Int
0
where
len :: Int
len = ByteString -> Int
B.length ByteString
ps
combine :: a -> a -> a -> a -> a
combine a
w1 a
w2 a
w3 a
w4 =
a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w1) Int
24
a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w2) Int
16
a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w3) Int
8
a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w4)
{-# INLINE beginChunk #-}