Improve external buffer API
This commit is contained in:
parent
452fce4ea5
commit
6e245576e8
3 changed files with 47 additions and 16 deletions
10
cbits/wrap-rust-haskell-ffi.c
Normal file
10
cbits/wrap-rust-haskell-ffi.c
Normal file
|
@ -0,0 +1,10 @@
|
||||||
|
// Forward-declare the Rust-exported function
|
||||||
|
void haskell_ffi_external_free(void* vec);
|
||||||
|
|
||||||
|
// Wrapper around the Rust function that takes an additional (unused) argument,
|
||||||
|
// which makes it match the Haskell `FinalizerEnvPtr` type. The wrapper also
|
||||||
|
// avoids linker errors when the Rust library is not available (of course,
|
||||||
|
// the Rust library must be linked into the final application).
|
||||||
|
void haskell_ffi_external_free_env(void* vec, void* ptr) {
|
||||||
|
haskell_ffi_external_free(vec);
|
||||||
|
}
|
|
@ -93,6 +93,8 @@ library
|
||||||
, th-abstraction
|
, th-abstraction
|
||||||
, vector
|
, vector
|
||||||
, wide-word
|
, wide-word
|
||||||
|
c-sources:
|
||||||
|
cbits/wrap-rust-haskell-ffi.c
|
||||||
|
|
||||||
test-suite test-foreign-rust
|
test-suite test-foreign-rust
|
||||||
import:
|
import:
|
||||||
|
|
|
@ -6,48 +6,67 @@ module Foreign.Rust.Marshall.External (
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Codec.Borsh
|
import Codec.Borsh
|
||||||
import Control.Exception
|
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import Data.Word
|
import Data.Word
|
||||||
import Foreign.C
|
import Foreign.C
|
||||||
import Foreign.Concurrent
|
|
||||||
import Foreign.Ptr
|
import Foreign.Ptr
|
||||||
|
|
||||||
import qualified Data.ByteString.Internal as Strict
|
import qualified Data.ByteString.Internal as Strict
|
||||||
|
|
||||||
import Foreign.Rust.Marshall.Util
|
import Foreign.Rust.Marshall.Util
|
||||||
|
import Foreign.ForeignPtr
|
||||||
|
|
||||||
data External
|
data ExternalBuffer
|
||||||
|
|
||||||
foreign import ccall "haskell_ffi_external_ptr"
|
{-------------------------------------------------------------------------------
|
||||||
|
Foreign imports
|
||||||
|
|
||||||
|
Although 'externalPtr' and 'externalLen' are morally pure, we make
|
||||||
|
them live in IO to make reasoning about order of operations easier in
|
||||||
|
'fromExternalBorsh'.
|
||||||
|
|
||||||
|
These C functions are defined in the companion Rust @haskell-ffi@ library.
|
||||||
|
-------------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
foreign import ccall unsafe "haskell_ffi_external_ptr"
|
||||||
externalPtr
|
externalPtr
|
||||||
:: Ptr External -> Ptr Word8
|
:: Ptr ExternalBuffer -> IO (Ptr Word8)
|
||||||
|
|
||||||
foreign import ccall "haskell_ffi_external_len"
|
foreign import ccall unsafe "haskell_ffi_external_len"
|
||||||
externalLen
|
externalLen
|
||||||
:: Ptr External -> CSize
|
:: Ptr ExternalBuffer -> IO CSize
|
||||||
|
|
||||||
foreign import ccall "haskell_ffi_external_free"
|
foreign import ccall unsafe "&haskell_ffi_external_free_env"
|
||||||
externalFree
|
externalFree
|
||||||
:: Ptr External -> IO ()
|
:: FinalizerEnvPtr ExternalBuffer Word8
|
||||||
|
|
||||||
-- | Internal auxiliary: cast pointer
|
{-------------------------------------------------------------------------------
|
||||||
|
Internal auxiliary
|
||||||
|
-------------------------------------------------------------------------------}
|
||||||
|
|
||||||
|
-- | Cast pointer
|
||||||
--
|
--
|
||||||
-- For ease of integration with c2hs, 'fromExternalBorsh' takes a @Ptr ()@ as
|
-- For ease of integration with c2hs, 'fromExternalBorsh' takes a @Ptr ()@ as
|
||||||
-- input instead of the more accurate @Ptr External@.
|
-- input instead of the more accurate @Ptr ExternalBuffer@.
|
||||||
castToExternal :: Ptr () -> Ptr External
|
castToExternal :: Ptr () -> Ptr ExternalBuffer
|
||||||
castToExternal = castPtr
|
castToExternal = castPtr
|
||||||
|
|
||||||
|
{-------------------------------------------------------------------------------
|
||||||
|
Public API
|
||||||
|
-------------------------------------------------------------------------------}
|
||||||
|
|
||||||
-- | Output marshaller for values stored in Rust-allocated buffer
|
-- | Output marshaller for values stored in Rust-allocated buffer
|
||||||
--
|
--
|
||||||
-- Should be used together with the Rust function @marshall_to_haskell_external@
|
-- Should be used together with the Rust function @marshall_to_haskell_external@
|
||||||
-- (from @haskell-ffi@).
|
-- (from @haskell-ffi@).
|
||||||
fromExternalBorsh :: (FromBorsh a, Typeable a) => Ptr () -> IO a
|
fromExternalBorsh :: (FromBorsh a, Typeable a) => Ptr () -> IO a
|
||||||
fromExternalBorsh (castToExternal -> ptr) = do
|
fromExternalBorsh (castToExternal -> vec) = do
|
||||||
len <- evaluate $ fromIntegral $ externalLen ptr
|
ptr <- externalPtr vec
|
||||||
fptr <- newForeignPtr (externalPtr ptr) (externalFree ptr)
|
len <- fromIntegral <$> externalLen vec
|
||||||
|
fptr <- newForeignPtrEnv externalFree vec ptr
|
||||||
|
|
||||||
let bs :: Strict.ByteString
|
let bs :: Strict.ByteString
|
||||||
bs = Strict.PS fptr 0 len
|
bs = Strict.fromForeignPtr fptr 0 len
|
||||||
|
|
||||||
return $ deserialiseStrictOrPanic bs
|
return $ deserialiseStrictOrPanic bs
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue