{-# LANGUAGE CPP #-}

module PtrPoker.Compat.Text where

#if MIN_VERSION_text(2,0,0)
import qualified Data.Text.Array as TextArray
import qualified Data.Text.Encoding as TextEncoding
import qualified Data.Text.Internal as TextInternal
import PtrPoker.Prelude

{-# INLINE destruct #-}
destruct :: (ByteArray# -> Int -> Int -> x) -> Text -> x
destruct :: forall x. (ByteArray# -> Int -> Int -> x) -> Text -> x
destruct ByteArray# -> Int -> Int -> x
k (TextInternal.Text (TextArray.ByteArray ByteArray#
arr) Int
off Int
len) = ByteArray# -> Int -> Int -> x
k ByteArray#
arr Int
off Int
len

{-# INLINE utf8EncodingSize #-}
utf8EncodingSize :: Text -> Int
utf8EncodingSize :: Text -> Int
utf8EncodingSize = (ByteArray# -> Int -> Int -> Int) -> Text -> Int
forall x. (ByteArray# -> Int -> Int -> x) -> Text -> x
destruct ((ByteArray# -> Int -> Int -> Int) -> Text -> Int)
-> (ByteArray# -> Int -> Int -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ \ByteArray#
_arr Int
_off Int
len -> Int
len

{-# INLINEABLE encodeInUtf8 #-}
encodeInUtf8 :: Text -> ByteString
encodeInUtf8 :: Text -> ByteString
encodeInUtf8 Text
t = Text -> ByteString
TextEncoding.encodeUtf8 Text
t

{-# INLINE pokeInUtf8 #-}
pokeInUtf8 :: Text -> Ptr Word8 -> IO (Ptr Word8)
pokeInUtf8 :: Text -> Ptr Word8 -> IO (Ptr Word8)
pokeInUtf8 (TextInternal.Text Array
arr Int
off Int
len) Ptr Word8
p =
  ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (Array -> Int -> Ptr Word8 -> Int -> ST RealWorld ()
forall s. Array -> Int -> Ptr Word8 -> Int -> ST s ()
TextArray.copyToPointer Array
arr Int
off Ptr Word8
p Int
len) IO () -> Ptr Word8 -> IO (Ptr Word8)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p Int
len
#else
import qualified Data.ByteString.Internal as ByteStringInternal
import qualified Data.Text.Array as TextArray
import qualified Data.Text.Internal as TextInternal
import qualified PtrPoker.Ffi as Ffi
import PtrPoker.Prelude

{-# INLINE destruct #-}
destruct :: (ByteArray# -> Int -> Int -> x) -> Text -> x
destruct k (TextInternal.Text (TextArray.Array arr) off len) =
  k arr off len

{-# INLINEABLE utf8EncodingSize #-}
utf8EncodingSize :: Text -> Int
utf8EncodingSize (TextInternal.Text (TextArray.Array arr) off len) =
  Ffi.countTextAllocationSize
    arr
    (fromIntegral off)
    (fromIntegral len)
    & unsafeDupablePerformIO
    & fromIntegral

{-# INLINEABLE encodeInUtf8 #-}
encodeInUtf8 :: Text -> ByteString
encodeInUtf8 (TextInternal.Text (TextArray.Array arr) off len) =
  if len == 0
    then mempty
    else ByteStringInternal.unsafeCreateUptoN (len * 3) $ \ptr -> do
      postPtr <- inline Ffi.encodeText ptr arr (fromIntegral off) (fromIntegral len)
      return (minusPtr postPtr ptr)

{-# INLINE pokeInUtf8 #-}
pokeInUtf8 :: Text -> Ptr Word8 -> IO (Ptr Word8)
pokeInUtf8 (TextInternal.Text (TextArray.Array arr) off len) p =
  Ffi.encodeText p arr (fromIntegral off) (fromIntegral len)
#endif