module HsForeign.String
(
mallocFromByteString
, mallocFromMaybeByteString
, withByteString
, withByteStrings
, StdString
, 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 qualified Data.ByteString.Unsafe as BS
import Data.Word
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Marshal
import Foreign.Ptr
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 #-}
withByteString :: ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withByteString :: ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withByteString (BS.PS ForeignPtr Word8
fp Int
off Int
len) Ptr Word8 -> Int -> IO a
f =
let fp' :: ForeignPtr b
fp' = ForeignPtr Word8
fp ForeignPtr Word8 -> Int -> ForeignPtr b
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
off
in ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
forall b. ForeignPtr b
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
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
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 ()
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 #-}