{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections #-}
module HsForeign.String
(
mallocFromByteString
, mallocFromMaybeByteString
, newStablePtrByteString
, withByteString
, withMaybeByteString
, withByteStringList
, withByteStrings
, withShortByteString
, StdString
, newStdString
, maybeNewStdString
, hs_new_std_string
, hs_new_std_string_def
, hs_std_string_size
, hs_std_string_cstr
, hs_delete_std_string
, unsafePeekStdString
) where
import Control.Exception (AssertionFailed (..), throw)
import Control.Monad (unless)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BS
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short.Internal as BSS
import qualified Data.ByteString.Unsafe as BS
import Data.Word
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.ForeignPtr.Unsafe
import Foreign.Marshal
import Foreign.Ptr
import Foreign.StablePtr
import GHC.Exts (touch#)
import HsForeign.Primitive
mallocFromByteString :: ByteString -> IO (CString, Int)
mallocFromByteString :: ByteString -> IO (CString, Int)
mallocFromByteString ByteString
bs =
ByteString
-> ((CString, Int) -> IO (CString, Int)) -> IO (CString, Int)
forall a. ByteString -> ((CString, Int) -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
bs (((CString, Int) -> IO (CString, Int)) -> IO (CString, Int))
-> ((CString, Int) -> IO (CString, Int)) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \(CString
src, Int
len) -> do
CString
buf <- Int -> IO CString
forall a. Int -> IO (Ptr a)
mallocBytes Int
len
CString -> CString -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes CString
buf CString
src Int
len
(CString, Int) -> IO (CString, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
buf, Int
len)
{-# INLINE mallocFromByteString #-}
mallocFromMaybeByteString :: Maybe ByteString -> IO (CString, Int)
mallocFromMaybeByteString :: Maybe ByteString -> IO (CString, Int)
mallocFromMaybeByteString (Just ByteString
bs) = ByteString -> IO (CString, Int)
mallocFromByteString ByteString
bs
mallocFromMaybeByteString Maybe ByteString
Nothing = (CString, Int) -> IO (CString, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
forall a. Ptr a
nullPtr, Int
0)
{-# INLINE mallocFromMaybeByteString #-}
newStablePtrByteString :: ByteString -> IO (CString, Int, StablePtr ByteString)
newStablePtrByteString :: ByteString -> IO (CString, Int, StablePtr ByteString)
newStablePtrByteString ByteString
bs = do
!StablePtr ByteString
sp <- ByteString -> IO (StablePtr ByteString)
forall a. a -> IO (StablePtr a)
newStablePtr ByteString
bs
let (ForeignPtr Word8
fp, Int
len) = ByteString -> (ForeignPtr Word8, Int)
toForeignPtr0 ByteString
bs
!p :: Ptr Word8
p = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp
(CString, Int, StablePtr ByteString)
-> IO (CString, Int, StablePtr ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p, Int
len, StablePtr ByteString
sp)
withByteString :: ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withByteString :: ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withByteString ByteString
bs Ptr Word8 -> Int -> IO a
f =
let (ForeignPtr Word8
fp, Int
len) = ByteString -> (ForeignPtr Word8, Int)
toForeignPtr0 ByteString
bs
in ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO a
f Ptr Word8
p Int
len
{-# INLINABLE withByteString #-}
withMaybeByteString :: Maybe ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withMaybeByteString :: Maybe ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withMaybeByteString Maybe ByteString
Nothing Ptr Word8 -> Int -> IO a
f = Ptr Word8 -> Int -> IO a
f Ptr Word8
forall a. Ptr a
nullPtr Int
0
withMaybeByteString (Just ByteString
bs) Ptr Word8 -> Int -> IO a
f =
let (ForeignPtr Word8
fp, Int
len) = ByteString -> (ForeignPtr Word8, Int)
toForeignPtr0 ByteString
bs
in ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO a
f Ptr Word8
p Int
len
{-# INLINABLE withMaybeByteString #-}
withByteStringList
:: [ByteString]
-> (Ptr (Ptr Word8) -> Ptr Int -> Int -> IO a)
-> IO a
withByteStringList :: [ByteString] -> (Ptr (Ptr Word8) -> Ptr Int -> Int -> IO a) -> IO a
withByteStringList [ByteString]
bss Ptr (Ptr Word8) -> Ptr Int -> Int -> IO a
f = do
let ([ForeignPtr Word8]
ps, [Int]
lens) = [(ForeignPtr Word8, Int)] -> ([ForeignPtr Word8], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip ((ByteString -> (ForeignPtr Word8, Int))
-> [ByteString] -> [(ForeignPtr Word8, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (ForeignPtr Word8, Int)
toForeignPtr0 [ByteString]
bss)
PrimArray Int -> (Ptr Int -> Int -> IO a) -> IO a
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray ([Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
lens) ((Ptr Int -> Int -> IO a) -> IO a)
-> (Ptr Int -> Int -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Int
lens' Int
num ->
[ForeignPtr Word8] -> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a
forall a b. [ForeignPtr a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withForeignPtrList [ForeignPtr Word8]
ps ((Ptr (Ptr Word8) -> Int -> IO a) -> IO a)
-> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
ps' Int
num_ps -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
num_ps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AssertionFailed -> IO ()
forall a e. Exception e => e -> a
throw (AssertionFailed -> IO ()) -> AssertionFailed -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> AssertionFailed
AssertionFailed String
"This should never happen..."
Ptr (Ptr Word8) -> Ptr Int -> Int -> IO a
f Ptr (Ptr Word8)
ps' Ptr Int
lens' Int
num
{-# DEPRECATED withByteStrings "use withByteStringList instead" #-}
withByteStrings
:: [ByteString]
-> (Ptr (Ptr Word8) -> Ptr Int -> Ptr Int -> Int -> IO a)
-> IO a
withByteStrings :: [ByteString]
-> (Ptr (Ptr Word8) -> Ptr Int -> Ptr Int -> Int -> IO a) -> IO a
withByteStrings [ByteString]
bss Ptr (Ptr Word8) -> Ptr Int -> Ptr Int -> Int -> IO a
f = do
let exbs :: ByteString -> (ForeignPtr Word8, b, c)
exbs (BS.PS ForeignPtr Word8
payload Int
off Int
len) = (ForeignPtr Word8
payload, Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off, Int -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
([ForeignPtr Word8]
ps, [Int]
offs, [Int]
lens) = [(ForeignPtr Word8, Int, Int)]
-> ([ForeignPtr Word8], [Int], [Int])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ((ByteString -> (ForeignPtr Word8, Int, Int))
-> [ByteString] -> [(ForeignPtr Word8, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (ForeignPtr Word8, Int, Int)
forall b c.
(Num b, Num c) =>
ByteString -> (ForeignPtr Word8, b, c)
exbs [ByteString]
bss)
PrimArray Int -> (Ptr Int -> Int -> IO a) -> IO a
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray ([Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
lens) ((Ptr Int -> Int -> IO a) -> IO a)
-> (Ptr Int -> Int -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Int
lens' Int
num ->
PrimArray Int -> (Ptr Int -> Int -> IO a) -> IO a
forall a b. Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
withPrimArray ([Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
offs) ((Ptr Int -> Int -> IO a) -> IO a)
-> (Ptr Int -> Int -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Int
offs' Int
_num_offs ->
[ForeignPtr Word8] -> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a
forall a b. [ForeignPtr a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
withForeignPtrList [ForeignPtr Word8]
ps ((Ptr (Ptr Word8) -> Int -> IO a) -> IO a)
-> (Ptr (Ptr Word8) -> Int -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Word8)
ps' Int
_num_ps -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
_num_offs Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
_num_ps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AssertionFailed -> IO ()
forall a e. Exception e => e -> a
throw (AssertionFailed -> IO ()) -> AssertionFailed -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> AssertionFailed
AssertionFailed String
"This should never happen..."
Ptr (Ptr Word8) -> Ptr Int -> Ptr Int -> Int -> IO a
f Ptr (Ptr Word8)
ps' Ptr Int
offs' Ptr Int
lens' Int
num
withShortByteString :: ShortByteString -> (ByteArray# -> Int -> IO a) -> IO a
withShortByteString :: ShortByteString -> (ByteArray# -> Int -> IO a) -> IO a
withShortByteString sbs :: ShortByteString
sbs@(BSS.SBS ByteArray#
ba#) ByteArray# -> Int -> IO a
f = do
!a
r <- ByteArray# -> Int -> IO a
f ByteArray#
ba# (ShortByteString -> Int
BSS.length ShortByteString
sbs)
(State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState IO) -> State# (PrimState IO)) -> IO ())
-> (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteArray# -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# ByteArray#
ba#
a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
data StdString
foreign import ccall unsafe hs_new_std_string :: Ptr Word8 -> Int -> IO (Ptr StdString)
foreign import ccall unsafe hs_new_std_string_def :: IO (Ptr StdString)
foreign import ccall unsafe hs_std_string_size :: Ptr StdString -> IO Int
foreign import ccall unsafe hs_std_string_cstr :: Ptr StdString -> IO (Ptr Word8)
foreign import ccall unsafe hs_delete_std_string :: Ptr StdString -> IO ()
newStdString :: ByteString -> IO (Ptr StdString)
newStdString :: ByteString -> IO (Ptr StdString)
newStdString ByteString
bs = ByteString
-> (Ptr Word8 -> Int -> IO (Ptr StdString)) -> IO (Ptr StdString)
forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withByteString ByteString
bs ((Ptr Word8 -> Int -> IO (Ptr StdString)) -> IO (Ptr StdString))
-> (Ptr Word8 -> Int -> IO (Ptr StdString)) -> IO (Ptr StdString)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Int -> IO (Ptr StdString)
hs_new_std_string
maybeNewStdString :: Maybe ByteString -> IO (Ptr StdString)
maybeNewStdString :: Maybe ByteString -> IO (Ptr StdString)
maybeNewStdString Maybe ByteString
Nothing = Ptr StdString -> IO (Ptr StdString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr StdString
forall a. Ptr a
nullPtr
maybeNewStdString (Just ByteString
bs) = ByteString -> IO (Ptr StdString)
newStdString ByteString
bs
unsafePeekStdString :: Ptr StdString -> IO ByteString
unsafePeekStdString :: Ptr StdString -> IO ByteString
unsafePeekStdString Ptr StdString
stdstring = do
Int
siz <- Ptr StdString -> IO Int
hs_std_string_size Ptr StdString
stdstring
Ptr Word8
ptr <- Ptr StdString -> IO (Ptr Word8)
hs_std_string_cstr Ptr StdString
stdstring
Ptr Word8 -> Int -> IO () -> IO ByteString
BS.unsafePackCStringFinalizer Ptr Word8
ptr Int
siz (Ptr StdString -> IO ()
hs_delete_std_string Ptr StdString
stdstring)
{-# INLINE unsafePeekStdString #-}
toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int)
#if !MIN_VERSION_bytestring(0, 11, 0)
toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int)
toForeignPtr0 (BS.PS ForeignPtr Word8
fp Int
off Int
len) = (ForeignPtr Word8
fp ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
off, Int
len)
#else
toForeignPtr0 = BS.toForeignPtr0
#endif