Use unsafeWithForeignPtr when available

src/Data/Text/Encoding.hs

@@ -69,9 +69,10 @@ import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))
 import Control.Monad.ST (runST)
 import Data.Bits ((.&.))
 import Data.ByteString as B
-import Data.ByteString.Internal as B hiding (c2w)
+import qualified Data.ByteString.Internal as B
 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)
@@ -83,7 +84,6 @@ import Foreign.C.Types (CSize(CSize))
 #else
 import Foreign.C.Types (CSize)
 #endif
-import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Marshal.Utils (with)
 import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
 import Foreign.Storable (Storable, peek, poke)
@@ -128,7 +128,7 @@ decodeLatin1 bs = withBS bs aux where
   aux fp len = text a 0 len
    where
     a = A.run (A.new len >>= unsafeIOToST . go)
-    go dest = withForeignPtr fp $ \ptr -> do
+    go dest = unsafeWithForeignPtr fp $ \ptr -> do
       c_decode_latin1 (A.maBA dest) ptr (ptr `plusPtr` len)
       return dest
 
@@ -144,7 +144,7 @@ decodeUtf8With :: OnDecodeError -> ByteString -> Text
 decodeUtf8With onErr bs = withBS bs aux
  where
   aux fp len = runText $ \done -> do
-    let go dest = withForeignPtr fp $ \ptr ->
+    let go dest = unsafeWithForeignPtr fp $ \ptr ->
           with (0::CSize) $ \destOffPtr -> do
             let end = ptr `plusPtr` len
                 loop curPtr = do
@@ -300,7 +300,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
     aux fp len = runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)
        where
         decodeChunkToBuffer :: A.MArray s -> IO Decoding
-        decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
+        decodeChunkToBuffer dest = unsafeWithForeignPtr fp $ \ptr ->
           with (0::CSize) $ \destOffPtr ->
           with codepoint0 $ \codepointPtr ->
           with state0 $ \statePtr ->
@@ -433,18 +433,18 @@ encodeUtf8 :: Text -> ByteString
 encodeUtf8 (Text arr off len)
   | len == 0  = B.empty
   | otherwise = unsafeDupablePerformIO $ do
-  fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
-  withForeignPtr fp $ \ptr ->
+  fp <- B.mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
+  unsafeWithForeignPtr fp $ \ptr ->
     with ptr $ \destPtr -> do
       c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
       newDest <- peek destPtr
       let utf8len = newDest `minusPtr` ptr
       if utf8len >= len `shiftR` 1
         then return (mkBS fp utf8len)
         else do
-          fp' <- mallocByteString utf8len
-          withForeignPtr fp' $ \ptr' -> do
-            memcpy ptr' ptr (fromIntegral utf8len)
+          fp' <- B.mallocByteString utf8len
+          unsafeWithForeignPtr fp' $ \ptr' -> do
+            B.memcpy ptr' ptr (fromIntegral utf8len)
             return (mkBS fp' utf8len)
 
 -- | Decode text from little endian UTF-16 encoding.

src/Data/Text/Foreign.hs

@@ -42,10 +42,11 @@ import Control.Monad.ST (unsafeIOToST)
 import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Text.Internal (Text(..), empty)
+import Data.Text.Internal.Functions (unsafeWithForeignPtr)
 import Data.Text.Unsafe (lengthWord16)
 import Data.Word (Word16)
 import Foreign.C.String (CStringLen)
-import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray)
 import Foreign.Marshal.Alloc (allocaBytes)
 import Foreign.Ptr (Ptr, castPtr, plusPtr)
 import Foreign.Storable (peek, poke)
@@ -150,7 +151,7 @@ useAsPtr t@(Text _arr _off len) action =
 asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)
 asForeignPtr t@(Text _arr _off len) = do
   fp <- mallocForeignPtrArray len
-  withForeignPtr fp $ unsafeCopyToPtr t
+  unsafeWithForeignPtr fp $ unsafeCopyToPtr t
   return (fp, I16 len)
 
 -- | /O(n)/ Decode a C string with explicit length, which is assumed

src/Data/Text/Internal/ByteStringCompat.hs

@@ -53,3 +53,4 @@ plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr o
  #-}
 #endif
 #endif
+

src/Data/Text/Internal/Encoding/Fusion.hs

@@ -44,8 +44,9 @@ import Data.Text.Encoding.Error
 import Data.Text.Internal.Encoding.Fusion.Common
 import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
 import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
+import Data.Text.Internal.Functions (unsafeWithForeignPtr)
 import Data.Word (Word8, Word16, Word32)
-import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr)
 import Foreign.Storable (pokeByteOff)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Unsafe as B
@@ -177,13 +178,13 @@ unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
           Yield x s'
               | off == n -> realloc fp n off s' x
               | otherwise -> do
-            withForeignPtr fp $ \p -> pokeByteOff p off x
+            unsafeWithForeignPtr fp $ \p -> pokeByteOff p off x
             loop n (off+1) s' fp
       {-# NOINLINE realloc #-}
       realloc fp n off s x = do
         let n' = n+n
         fp' <- copy0 fp n n'
-        withForeignPtr fp' $ \p -> pokeByteOff p off x
+        unsafeWithForeignPtr fp' $ \p -> pokeByteOff p off x
         loop n' (off+1) s fp'
       {-# NOINLINE trimUp #-}
       trimUp fp _ off = return $! mkBS fp off
@@ -194,8 +195,8 @@ unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
 #endif
         do
           dest <- mallocByteString destLen
-          withForeignPtr src  $ \src'  ->
-              withForeignPtr dest $ \dest' ->
+          unsafeWithForeignPtr src  $ \src'  ->
+              unsafeWithForeignPtr dest $ \dest' ->
                   memcpy dest' src' (fromIntegral srcLen)
           return dest
 

src/Data/Text/Internal/Functions.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- |
 -- Module      : Data.Text.Internal.Functions
 -- Copyright   : 2010 Bryan O'Sullivan
@@ -15,9 +17,18 @@
 
 module Data.Text.Internal.Functions
     (
-      intersperse
+      intersperse,
+      unsafeWithForeignPtr
     ) where
 
+import Foreign.Ptr (Ptr)
+import Foreign.ForeignPtr (ForeignPtr)
+#if MIN_VERSION_base(4,15,0)
+import qualified GHC.ForeignPtr (unsafeWithForeignPtr)
+#else
+import qualified Foreign.ForeignPtr (withForeignPtr)
+#endif
+
 -- | A lazier version of Data.List.intersperse.  The other version
 -- causes space leaks!
 intersperse :: a -> [a] -> [a]
@@ -27,3 +38,10 @@ intersperse sep (x:xs) = x : go xs
     go []     = []
     go (y:ys) = sep : y: go ys
 {-# INLINE intersperse #-}
+
+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+#if MIN_VERSION_base(4,15,0)
+unsafeWithForeignPtr = GHC.ForeignPtr.unsafeWithForeignPtr
+#else
+unsafeWithForeignPtr = Foreign.ForeignPtr.withForeignPtr
+#endif

src/Data/Text/Internal/Lazy/Encoding/Fusion.hs

@@ -35,18 +35,20 @@ module Data.Text.Internal.Lazy.Encoding.Fusion
 import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Unsafe as B
+import Data.Text.Internal.ByteStringCompat
 import Data.Text.Internal.Encoding.Fusion.Common
 import Data.Text.Encoding.Error
 import Data.Text.Internal.Fusion (Step(..), Stream(..))
 import Data.Text.Internal.Fusion.Size
 import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
 import Data.Text.Internal.Unsafe.Shift (shiftL)
+import Data.Text.Internal.Functions (unsafeWithForeignPtr)
 import Data.Word (Word8, Word16, Word32)
 import qualified Data.Text.Internal.Encoding.Utf8 as U8
 import qualified Data.Text.Internal.Encoding.Utf16 as U16
 import qualified Data.Text.Internal.Encoding.Utf32 as U32
 import Data.Text.Unsafe (unsafeDupablePerformIO)
-import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr)
 import Foreign.Storable (pokeByteOff)
 import Data.ByteString.Internal (mallocByteString, memcpy)
 #if defined(ASSERTS)
@@ -289,13 +291,13 @@ unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
                       return $! Chunk (trimUp fp off) (chunk s newLen)
                     | off == n -> realloc fp n off s' x
                     | otherwise -> do
-                      withForeignPtr fp $ \p -> pokeByteOff p off x
+                      unsafeWithForeignPtr fp $ \p -> pokeByteOff p off x
                       loop n (off+1) s' fp
             {-# NOINLINE realloc #-}
             realloc fp n off s x = do
               let n' = min (n+n) chunkSize
               fp' <- copy0 fp n n'
-              withForeignPtr fp' $ \p -> pokeByteOff p off x
+              unsafeWithForeignPtr fp' $ \p -> pokeByteOff p off x
               loop n' (off+1) s fp'
             trimUp fp off = mkBS fp off
             copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)
@@ -305,8 +307,8 @@ unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
 #endif
               do
                 dest <- mallocByteString destLen
-                withForeignPtr src  $ \src'  ->
-                    withForeignPtr dest $ \dest' ->
+                unsafeWithForeignPtr src  $ \src'  ->
+                    unsafeWithForeignPtr dest $ \dest' ->
                         memcpy dest' src' (fromIntegral srcLen)
                 return dest