{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash                #-}
{-# LANGUAGE UnliftedFFITypes         #-}

module Data.JsonStream.Unescape (
  unescapeText
) where

import           Control.Exception          (evaluate, throw, try)
import           Control.Monad.ST.Unsafe    (unsafeIOToST, unsafeSTToIO)
import           Data.ByteString            as B
import           Data.ByteString.Internal   as B hiding (c2w)
import qualified Data.Text.Array            as A
import           Data.Text.Encoding.Error   (UnicodeException (..))
import           Data.Text.Internal         (Text (..))
import           Data.Text.Internal.Private (runText)
import           Data.Text.Unsafe           (unsafeDupablePerformIO)
import           Data.Word                  (Word8)
import           Foreign.C.Types            (CInt (..), CSize (..))
import           Foreign.ForeignPtr         (withForeignPtr)
import           Foreign.Marshal.Utils      (with)
import           Foreign.Ptr                (Ptr, plusPtr)
import           Foreign.Storable           (peek)
import           GHC.Base                   (MutableByteArray#)

foreign import ccall unsafe "_jstream_decode_string" c_js_decode
    :: MutableByteArray# s -> Ptr CSize
    -> Ptr Word8 -> Ptr Word8 -> IO CInt

unescapeText' :: ByteString -> Text
unescapeText' :: ByteString -> Text
unescapeText' (PS ForeignPtr Word8
fp Int
off Int
len) = (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
runText ((forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text)
-> (forall s. (MArray s -> Int -> ST s Text) -> ST s Text) -> Text
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 = ForeignPtr Word8 -> (Ptr Word8 -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Text) -> IO Text)
-> (Ptr Word8 -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
        CSize -> (Ptr CSize -> IO Text) -> IO Text
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (CSize
0::CSize) ((Ptr CSize -> IO Text) -> IO Text)
-> (Ptr CSize -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
destOffPtr -> do
          let end :: Ptr b
end = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
              loop :: Ptr Word8 -> IO Text
loop Ptr Word8
curPtr = do
                CInt
res <- MutableByteArray# s
-> Ptr CSize -> Ptr Word8 -> Ptr Word8 -> IO CInt
forall s.
MutableByteArray# s
-> Ptr CSize -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_js_decode (MArray s -> MutableByteArray# s
forall s. MArray s -> MutableByteArray# s
A.maBA MArray s
dest) Ptr CSize
destOffPtr Ptr Word8
curPtr Ptr Word8
forall b. Ptr b
end
                case CInt
res of
                  CInt
0 -> do
                    CSize
n <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
destOffPtr
                    ST s Text -> IO Text
forall s a. ST s a -> IO a
unsafeSTToIO (MArray s -> Int -> ST s Text
done MArray s
dest (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
n))
                  CInt
_ ->
                    UnicodeException -> IO Text
forall a e. Exception e => e -> a
throw (String -> Maybe Word8 -> UnicodeException
DecodeError String
desc Maybe Word8
forall a. Maybe a
Nothing)
          Ptr Word8 -> IO Text
loop (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)
  (IO Text -> ST s Text
forall a s. IO a -> ST s a
unsafeIOToST (IO Text -> ST s Text)
-> (MArray s -> IO Text) -> MArray s -> ST s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MArray s -> IO Text
go) (MArray s -> ST s Text) -> ST s (MArray s) -> ST s Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
 where
  desc :: String
desc = String
"Data.JsonStream.Unescape.unescapeText': Invalid UTF-8 stream"
{-# INLINE unescapeText' #-}

unescapeText :: ByteString -> Either UnicodeException Text
unescapeText :: ByteString -> Either UnicodeException Text
unescapeText = IO (Either UnicodeException Text) -> Either UnicodeException Text
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either UnicodeException Text) -> Either UnicodeException Text)
-> (ByteString -> IO (Either UnicodeException Text))
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> IO (Either UnicodeException Text)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Text -> IO (Either UnicodeException Text))
-> (ByteString -> IO Text)
-> ByteString
-> IO (Either UnicodeException Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO Text
forall a. a -> IO a
evaluate (Text -> IO Text) -> (ByteString -> Text) -> ByteString -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
unescapeText'
{-# INLINE unescapeText #-}