{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
module Data.Text.Internal.ByteStringCompat (mkBS, withBS) where
import Data.ByteString.Internal (ByteString (..))
import Data.Word (Word8)
import Foreign.ForeignPtr (ForeignPtr)
#if !MIN_VERSION_bytestring(0,11,0)
#if MIN_VERSION_base(4,10,0)
import GHC.ForeignPtr (plusForeignPtr)
#else
import GHC.ForeignPtr (ForeignPtr(ForeignPtr))
import GHC.Types (Int (..))
import GHC.Prim (plusAddr#)
#endif
#endif
mkBS :: ForeignPtr Word8 -> Int -> ByteString
#if MIN_VERSION_bytestring(0,11,0)
mkBS :: ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
dfp Int
n = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
dfp Int
n
#else
mkBS dfp n = PS dfp 0 n
#endif
{-# INLINE mkBS #-}
withBS :: ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
#if MIN_VERSION_bytestring(0,11,0)
withBS :: forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS (BS !ForeignPtr Word8
sfp !Int
slen) ForeignPtr Word8 -> Int -> r
kont = ForeignPtr Word8 -> Int -> r
kont ForeignPtr Word8
sfp Int
slen
#else
withBS (PS !sfp !soff !slen) kont = kont (plusForeignPtr sfp soff) slen
#endif
{-# INLINE withBS #-}
#if !MIN_VERSION_bytestring(0,11,0)
#if !MIN_VERSION_base(4,10,0)
plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts
{-# INLINE [0] plusForeignPtr #-}
{-# RULES
"ByteString plusForeignPtr/0" forall fp .
plusForeignPtr fp 0 = fp
#-}
#endif
#endif