foreign 0.1.2.0 → 0.2.0.0

raw patch · 7 files changed

+182/−92 lines, 7 filesdep ~bytestringdep ~primitive-unliftedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, primitive-unlifted

API changes (from Hackage documentation)

Files

• cbits/hs_cpp_std.cpp +84/−0
• cbits/hs_std_string.cpp +0/−37
• foreign.cabal +13/−7
• include/hs_foreign.h +15/−0
• src/HsForeign/CppStd.hs +60/−0
• src/HsForeign/String.hs +1/−41
• test/HsForeign/StringSpec.hs +9/−7

@@ -0,0 +1,84 @@+#include <HsFFI.h>++#include <cstring>+#include <string>+#include <vector>++#define CAL_OFFSET(NAME, VAL_TYPE)                                             \+  VAL_TYPE* cal_offset_##NAME(VAL_TYPE* current, HsInt offset) {               \+    return current + offset;                                                   \+  }++#define GET_SIZE(NAME, TYPE)                                                   \+  HsInt get_size_##NAME(const TYPE* t) { return (t) ? t->size() : 0; }++#define PEEK_VECTOR(NAME, VEC_TYPE, VAL_TYPE)                                  \+  void peek_##NAME(const VEC_TYPE* vec, HsInt len, VAL_TYPE* vals) {           \+    assert(("peek_##NAME: size mismatch!", len == vec->size()));               \+    for (int i = 0; i < len; i++) {                                            \+      (vals)[i] = (*vec)[i];                                                   \+    }                                                                          \+  }++// ----------------------------------------------------------------------------+extern "C" {++// std::string++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);+}++std::string* hs_new_std_string_copy(std::string&& str) {+  auto value = new std::string;+  *value = str;+  return value;+}++void hs_delete_std_string(std::string* str) { delete str; }++// std::vector++GET_SIZE(vec_of_string, std::vector<std::string>)++HsInt hs_std_vector_string_size(std::vector<std::string>* v) {+  if (v)+    return (HsInt)v->size();+  else+    return 0;+}++std::string* hs_std_vector_string_data(std::vector<std::string>* v) {+  if (v)+    return v->data();+  else+    return nullptr;+}++void hs_delete_std_vector_string(std::vector<std::string>* v) { delete v; }++// ----------------------------------------------------------------------------+} // End extern "C"++#undef GET_SIZE

@@ -1,37 +0,0 @@-#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.2.0+version:            0.2.0.0 synopsis:           A collection of helpers for ffi. description:   Please see the README on Github at <https://github.com/4eUeP/foreign#readme>@@ -10,13 +10,14 @@ copyright:          Copyright (c) author:             mu maintainer:         mu@laxcat.xyz-tested-with:        GHC ==8.10.7+tested-with:        GHC ==8.10.7 || ==9.2.5 category:           Foreign homepage:           https://github.com/4eUeP/foreign bug-reports:        https://github.com/4eUeP/foreign/issues build-type:         Simple extra-source-files:   ChangeLog.md+  include/**/*.h   README.md  source-repository head@@ -46,20 +47,25 @@ library   import:          common   hs-source-dirs:  src-  cxx-sources:     cbits/hs_std_string.cpp+  include-dirs:    include+  cxx-sources:     cbits/hs_cpp_std.cpp+  includes:        hs_foreign.h   exposed-modules:     HsForeign     HsForeign.AsyncFFI+    HsForeign.CppStd     HsForeign.Primitive     HsForeign.String     HsForeign.Utils +  -- We need to use primitive-unlifted < 1.0 to support ghc-9.*+  -- See: https://gitlab.haskell.org/ghc/ghc/-/issues/20908   build-depends:-    , base                >=4.14 && <5-    , bytestring          >=0.10 && <=0.12-    , ghc-prim            >=0.5  && <1.0+    , base                >=4.14    && <5+    , bytestring          >=0.10    && <0.12.0+    , ghc-prim            >=0.5     && <1.0     , primitive           ^>=0.7-    , primitive-unlifted  ^>=1.0+    , primitive-unlifted  >=0.1.3.1 && <0.2    cxx-options:     -std=c++17 -Werror=switch   extra-libraries: stdc++

@@ -0,0 +1,15 @@+#pragma once++// ----------------------------------------------------------------------------++#ifdef __cplusplus+extern "C" {+#endif+// ----------------------------------------------------------------------------++++// ----------------------------------------------------------------------------+#ifdef __cplusplus+} /* end extern "C" */+#endif

@@ -0,0 +1,60 @@+{-# LANGUAGE MagicHash #-}++module HsForeign.CppStd+  ( -- * StdString+    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+    -- * StdVector+  , StdVector++  ) where++import           Data.ByteString                (ByteString)+import qualified Data.ByteString.Unsafe         as BS+import           Data.Word+import           Foreign.Ptr++import           HsForeign.String (withByteString)++-------------------------------------------------------------------------------+-- StdString++data StdString++-- | New a c++ std::string from proviced bytestring.+--+-- The memory should be deallocated using delete when no longer required.+newStdString :: ByteString -> IO (Ptr StdString)+newStdString bs = withByteString bs $ hs_new_std_string++maybeNewStdString :: Maybe ByteString -> IO (Ptr StdString)+maybeNewStdString Nothing   = pure nullPtr+maybeNewStdString (Just bs) = newStdString bs++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 #-}++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 ()++-------------------------------------------------------------------------------+-- StdVector++data StdVector a++peekStdVectorOfString :: Ptr (StdVector StdString) -> [ByteString]+peekStdVectorOfString = undefined

@@ -5,8 +5,7 @@ {-# LANGUAGE TupleSections   #-}  module HsForeign.String-  ( -- * CString-    mallocFromByteString+  ( mallocFromByteString   , mallocFromMaybeByteString   , newStablePtrByteString   , withByteString@@ -14,17 +13,6 @@   , withByteStringList   , withByteStrings   , withShortByteString--    -- * CXX: std::string-  , 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)@@ -121,34 +109,6 @@   !r <- f ba# (BSS.length sbs)   primitive_ $ touch# ba#   pure r------------------------------------------------------------------------------------ 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 ()---- | New a c++ std::string from proviced bytestring.------ The memory should be deallocated using delete when no longer required.-newStdString :: ByteString -> IO (Ptr StdString)-newStdString bs = withByteString bs $ hs_new_std_string--maybeNewStdString :: Maybe ByteString -> IO (Ptr StdString)-maybeNewStdString Nothing   = pure nullPtr-maybeNewStdString (Just bs) = newStdString bs--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 #-}  ------------------------------------------------------------------------------- 

@@ -6,13 +6,15 @@ import           Test.QuickCheck import           Test.QuickCheck.Instances.ByteString () +import           HsForeign.CppStd 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+spec = do+  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