{-# LANGUAGE CPP       #-}
{-# LANGUAGE MagicHash #-}
module Database.PostgreSQL.LibPQ.Compat where

import Data.ByteString.Internal (ByteString (..))
import Data.Word                (Word8)
import Foreign.ForeignPtr       (ForeignPtr)

#if MIN_VERSION_bytestring(0,11,0)
import Data.ByteString.Internal (plusForeignPtr)
#endif

withPS :: ByteString -> (ForeignPtr Word8 -> Int -> Int -> r) -> r
#if MIN_VERSION_bytestring(0,11,0)
withPS :: forall r. ByteString -> (ForeignPtr Word8 -> Int -> Int -> r) -> r
withPS (BS ForeignPtr Word8
fp Int
len)     ForeignPtr Word8 -> Int -> Int -> r
kont = ForeignPtr Word8 -> Int -> Int -> r
kont ForeignPtr Word8
fp Int
0   Int
len
#else
withPS (PS fp off len) kont = kont fp off len
#endif
{-# INLINE withPS #-}

mkPS :: ForeignPtr Word8 -> Int -> Int -> ByteString
#if MIN_VERSION_bytestring(0,11,0)
mkPS :: ForeignPtr Word8 -> Int -> Int -> ByteString
mkPS ForeignPtr Word8
fp Int
off Int
len = ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp Int
off) Int
len
#else
mkPS fp off len = PS fp off len
#endif
{-# INLINE mkPS #-}