new StdString from ShortByteString

4eUeP · Oct 24, 2023 · f36ea47 · f36ea47
1 parent 1484f7e
commit f36ea47
Show file tree

Hide file tree

Showing 3 changed files with 50 additions and 6 deletions.
diff --git a/src/HsForeign/CppStd.hs b/src/HsForeign/CppStd.hs
@@ -4,24 +4,29 @@ module HsForeign.CppStd
   ( -- * StdString
     StdString
   , newStdString
+  , newStdStringFromShort
   , maybeNewStdString
   , hs_new_std_string
   , hs_new_std_string_def
   , hs_std_string_size
   , hs_std_string_cstr
   , hs_delete_std_string
   , unsafePeekStdString
+  , peekStdStringShort
     -- * StdVector
   , StdVector
 
   ) where
 
-import           Data.ByteString                (ByteString)
-import qualified Data.ByteString.Unsafe         as BS
+import           Data.ByteString        (ByteString)
+import           Data.ByteString.Short  (ShortByteString)
+import qualified Data.ByteString.Short  as BSS
+import qualified Data.ByteString.Unsafe as BS
 import           Data.Word
 import           Foreign.Ptr
 
-import           HsForeign.String (withByteString)
+import           HsForeign.Primitive
+import           HsForeign.String
 
 -------------------------------------------------------------------------------
 -- StdString
@@ -34,6 +39,9 @@ data StdString
 newStdString :: ByteString -> IO (Ptr StdString)
 newStdString bs = withByteString bs $ hs_new_std_string
 
+newStdStringFromShort :: ShortByteString -> IO (Ptr StdString)
+newStdStringFromShort sbs = withShortByteString sbs $ hs_new_std_string'
+
 maybeNewStdString :: Maybe ByteString -> IO (Ptr StdString)
 maybeNewStdString Nothing   = pure nullPtr
 maybeNewStdString (Just bs) = newStdString bs
@@ -45,7 +53,19 @@ unsafePeekStdString stdstring = do
   BS.unsafePackCStringFinalizer ptr siz (hs_delete_std_string stdstring)
 {-# INLINE unsafePeekStdString #-}
 
+peekStdStringShort :: Ptr StdString -> IO ShortByteString
+peekStdStringShort stdstring = do
+  siz <- hs_std_string_size stdstring
+  ptr <- hs_std_string_cstr stdstring
+  BSS.packCStringLen (castPtr ptr, siz)
+
+-- TODO
+--withStdString :: (Ptr StdString -> IO a) -> IO (ByteString, a)
+--withStdString = undefined
+
 foreign import ccall unsafe hs_new_std_string :: Ptr Word8 -> Int -> IO (Ptr StdString)
+foreign import ccall unsafe "hs_new_std_string"
+  hs_new_std_string' :: ByteArray# -> 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)
@@ -56,5 +76,20 @@ foreign import ccall unsafe hs_delete_std_string :: Ptr StdString -> IO ()
 
 data StdVector a
 
-peekStdVectorOfString :: Ptr (StdVector StdString) -> [ByteString]
-peekStdVectorOfString = undefined
+-- TODO
+
+--peekStdVectorOfString :: Ptr (StdVector StdString) -> [ByteString]
+--peekStdVectorOfString = undefined
+
+-------------------------------------------------------------------------------
+-- StdMap
+
+-- TODO
+
+-------------------------------------------------------------------------------
+-- StdMultiMap
+
+-- TODO
+
+--data CStdMultiMap k v
+--newtype StdMultiMap k v = StdMultiMap (CStdMultiMap k v)
diff --git a/src/HsForeign/Primitive.hs b/src/HsForeign/Primitive.hs
@@ -34,6 +34,7 @@ import           Control.Monad.Primitive
 import           Data.Primitive
 import           Data.Primitive.Unlifted.Array
 import           Foreign.ForeignPtr
+import           Foreign.Ptr
 import           GHC.Exts
 
 -------------------------------------------------------------------------------
@@ -127,7 +128,8 @@ withPrimArray arr f
 {-# INLINABLE withPrimArray #-}
 
 withPrimList :: Prim a => [a] -> (Ptr a -> Int -> IO b) -> IO b
-withPrimList = withPrimArray . primArrayFromList
+withPrimList [] f = f nullPtr 0
+withPrimList xs f = withPrimArray (primArrayFromList xs) f
 {-# INLINABLE withPrimList #-}
 
 -- From Z-Data package: Z.Foreign

diff --git a/test/HsForeign/StringSpec.hs b/test/HsForeign/StringSpec.hs
@@ -18,3 +18,10 @@ spec = do
       -- 3. unsafePeekStdString peek the std::string with a delete finalizer.
       let f = unsafePeekStdString =<< (withByteString s $ \p l -> hs_new_std_string p l)
        in unsafeDupablePerformIO f === s
+
+    prop "newStdStringFromShort" $ \s -> do
+      let f = do p <- newStdStringFromShort s
+                 s' <- peekStdStringShort p
+                 hs_delete_std_string p
+                 pure s'
+       in unsafeDupablePerformIO f === s