{-# 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