module HsForeign.String
  ( -- * CString
    mallocFromByteString
  , mallocFromMaybeByteString
  , withByteString
  , withByteStrings

    -- * CXX: std::string
  , 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

-------------------------------------------------------------------------------
-- CString

-- | Copies the content of the given ByteString.
--
-- The memory may be deallocated using free or finalizerFree when no longer
-- required.
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 =
  -- TODO: since bytestring 0.11.0.0, it exports the 'BS' constructor.
  -- we can change to benefit from the simplified BS constructor if we only
  -- support bytestring >= 0.11
  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

-- | Pass list of ByteStrings to FFI.
withByteStrings
  :: [ByteString]
  -> (Ptr (Ptr Word8) -> Ptr Int -> Ptr Int -> Int -> IO a)
  -- ^ cstring*, offset*, len*, list_len
  -> 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

-------------------------------------------------------------------------------
-- std::string

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 #-}