{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Hercules.CNix.Std.String
(
CStdString,
stdStringCtx,
moveToByteString,
withString,
new,
delete,
copyToByteString,
)
where
import Control.Exception (bracket, mask_)
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafePackMallocCStringLen)
import Foreign hiding (new)
import Hercules.CNix.Encapsulation
import Hercules.CNix.Std.String.Context
import Hercules.CNix.Std.String.Instances ()
import qualified Language.C.Inline as C
import System.IO.Unsafe (unsafePerformIO)
import Prelude
C.context (stdStringCtx <> C.bsCtx <> C.fptrCtx)
C.include "<string>"
C.include "<cstring>"
moveToByteString :: Ptr CStdString -> IO ByteString
moveToByteString :: Ptr CStdString -> IO ByteString
moveToByteString Ptr CStdString
s = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr (Ptr CChar)
ptr -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CSize
sz -> do
[C.block| void {
const std::string &s = *$(std::string *s);
size_t sz = *$(size_t *sz) = s.size();
char *ptr = *$(char **ptr) = (char*)malloc(sz);
std::memcpy((void *)ptr, s.c_str(), sz);
}|]
CSize
sz' <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
sz
Ptr CChar
ptr' <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
CStringLen -> IO ByteString
unsafePackMallocCStringLen (Ptr CChar
ptr', forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sz')
new :: ByteString -> IO (Ptr CStdString)
new :: ByteString -> IO (Ptr CStdString)
new ByteString
bs =
[C.block| std::string* {
return new std::string($bs-ptr:bs, $bs-len:bs);
}|]
delete :: Ptr CStdString -> IO ()
delete :: Ptr CStdString -> IO ()
delete Ptr CStdString
bs = [C.block| void { delete $(std::string *bs); }|]
withString :: ByteString -> (Ptr CStdString -> IO a) -> IO a
withString :: forall a. ByteString -> (Ptr CStdString -> IO a) -> IO a
withString ByteString
bs = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> IO (Ptr CStdString)
new ByteString
bs) Ptr CStdString -> IO ()
delete
finalize :: FinalizerPtr CStdString
{-# NOINLINE finalize #-}
finalize :: FinalizerPtr CStdString
finalize =
forall a. IO a -> a
unsafePerformIO
[C.exp|
void (*)(std::string *) {
[](std::string *v) {
delete v;
}
}
|]
newtype StdString = StdString (ForeignPtr CStdString)
instance HasEncapsulation CStdString StdString where
moveToForeignPtrWrapper :: Ptr CStdString -> IO StdString
moveToForeignPtrWrapper Ptr CStdString
x = ForeignPtr CStdString -> StdString
StdString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CStdString
finalize Ptr CStdString
x
copyToByteString :: StdString -> IO ByteString
copyToByteString :: StdString -> IO ByteString
copyToByteString (StdString ForeignPtr CStdString
s) = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr (Ptr CChar)
ptr -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CSize
sz -> do
[C.block| void {
const std::string &s = *$fptr-ptr:(std::string *s);
size_t sz = *$(size_t *sz) = s.size();
char *ptr = *$(char **ptr) = (char*)malloc(sz);
std::memcpy((void *)ptr, s.c_str(), sz);
}|]
CSize
sz' <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
sz
Ptr CChar
ptr' <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ptr
CStringLen -> IO ByteString
unsafePackMallocCStringLen (Ptr CChar
ptr', forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sz')