foreign 0.1.0.0 → 0.1.1.0

raw patch · 6 files changed

+164/−2 lines, 6 filesdep +bytestringdep +quickcheck-instancesPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, quickcheck-instances

API changes (from Hackage documentation)

Files

• cbits/hs_std_string.cpp +37/−0
• foreign.cabal +10/−2
• src/HsForeign.hs +2/−0
• src/HsForeign/Primitive.hs +6/−0
• src/HsForeign/String.hs +91/−0
• test/HsForeign/StringSpec.hs +18/−0

@@ -0,0 +1,37 @@+#include <HsFFI.h>++#include <cstring>+#include <string>++// ----------------------------------------------------------------------------+extern "C" {++HsInt hs_std_string_size(std::string* str) {+  if (str)+    return (HsInt)str->size();+  else+    return 0;+}++const char* hs_std_string_cstr(std::string* str) {+  if (str)+    return str->c_str();+  else+    return 0;+}++void hs_copy_std_string(std::string* str, HsInt size, char* buf) {+  if (str != NULL)+    memcpy(buf, str->c_str(), size);+}++std::string* hs_new_std_string_def() { return new std::string; }++std::string* hs_new_std_string(char* s, HsInt length) {+  return new std::string(s, length);+}++void hs_delete_std_string(std::string* str) { delete str; }++// ----------------------------------------------------------------------------+} // End extern "C"

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               foreign-version:            0.1.0.0+version:            0.1.1.0 synopsis:           A collection of helpers for ffi. description:   Please see the README on Github at <https://github.com/4eUeP/foreign#readme>@@ -46,17 +46,23 @@ library   import:          common   hs-source-dirs:  src+  cxx-sources:     cbits/hs_std_string.cpp   exposed-modules:     HsForeign     HsForeign.AsyncFFI     HsForeign.Primitive+    HsForeign.String    build-depends:     , base                >=4.14 && <5+    , bytestring          >=0.10 && <=0.12     , ghc-prim            >=0.5  && <1.0     , primitive           ^>=0.7     , primitive-unlifted  ^>=1.0 +  cxx-options:     -std=c++17 -Werror=switch+  extra-libraries: stdc+++ test-suite foreign-test   import:             common   type:               exitcode-stdio-1.0@@ -64,14 +70,16 @@   other-modules:     HsForeign.AsyncFFISpec     HsForeign.PrimitiveSpec+    HsForeign.StringSpec    hs-source-dirs:     test   c-sources:          test/cbits/ffi.c   build-depends:-    , base        >=4.14 && <5+    , base                  >=4.14 && <5     , foreign     , hspec     , QuickCheck+    , quickcheck-instances    build-tool-depends: hspec-discover:hspec-discover >=2 && <3   ghc-options:        -threaded -rtsopts -with-rtsopts=-N

@@ -1,7 +1,9 @@ module HsForeign   ( module HsForeign.Primitive   , module HsForeign.AsyncFFI+  , module HsForeign.String   ) where  import           HsForeign.AsyncFFI import           HsForeign.Primitive+import           HsForeign.String

@@ -10,6 +10,7 @@   , withPrimUnsafe   , allocPrimUnsafe   , withPrimArray+  , withPrimList   , allocPrimArray   , withPrimArrayUnsafe   , allocPrimArrayUnsafe@@ -125,6 +126,10 @@       withMutablePrimArrayContents buf $ \ptr -> f ptr siz {-# INLINABLE withPrimArray #-} +withPrimList :: Prim a => [a] -> (Ptr a -> Int -> IO b) -> IO b+withPrimList = withPrimArray . primArrayFromList+{-# INLINABLE withPrimList #-}+ -- From Z-Data package: Z.Foreign -- -- | Allocate a prim array and pass to FFI as pointer, freeze result into a 'PrimVector'.@@ -195,6 +200,7 @@       withPrimArray pa $ \ ppa _ -> do         writePrimArray ptrs i ppa         go ptrs (i+1) pas+{-# INLINABLE withPrimArrayList #-}  withForeignPtrList :: [ForeignPtr a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b withForeignPtrList fptrs f = do

@@ -0,0 +1,91 @@+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 bs =+  BS.unsafeUseAsCStringLen bs $ \(src, len) -> do+    buf <- mallocBytes len+    copyBytes buf src len+    return (buf, len)+{-# INLINE mallocFromByteString #-}++mallocFromMaybeByteString :: Maybe ByteString -> IO (CString, Int)+mallocFromMaybeByteString (Just bs) = mallocFromByteString bs+mallocFromMaybeByteString Nothing   = return (nullPtr, 0)+{-# INLINE mallocFromMaybeByteString #-}++withByteString :: ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a+withByteString (BS.PS fp off len) 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' = fp `plusForeignPtr` off+   in withForeignPtr fp' $ \p -> f p 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 bss f = do+  let exbs (BS.PS payload off len) = (payload, fromIntegral off, fromIntegral len)+      (ps, offs, lens) = unzip3 (map exbs bss)+  withPrimArray (primArrayFromList lens) $ \lens' num ->+    withPrimArray (primArrayFromList offs) $ \offs' _num_offs ->+    withForeignPtrList ps $ \ps' _num_ps -> do+      unless (num == _num_offs && num == _num_ps) $ throw $+        AssertionFailed "This should never happen..."+      f ps' offs' lens' 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 stdstring = do+  siz <- hs_std_string_size stdstring+  ptr <- hs_std_string_cstr stdstring+  BS.unsafePackCStringFinalizer ptr siz (hs_delete_std_string stdstring)+{-# INLINE unsafePeekStdString #-}

@@ -0,0 +1,18 @@+module HsForeign.StringSpec (spec) where++import           System.IO.Unsafe                     (unsafeDupablePerformIO)+import           Test.Hspec+import           Test.Hspec.QuickCheck+import           Test.QuickCheck+import           Test.QuickCheck.Instances.ByteString ()++import           HsForeign.String++spec :: Spec+spec = describe "StdString" $ do+  prop "unsafePeekStdString" $ \s ->+    -- 1. withByteString does nothing but pass the underlying ptr+    -- 2. hs_new_std_string copy construct a new std::string+    -- 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