mirror of
https://github.com/Drezil/dear-imgui.hs.git
synced 2024-11-22 16:57:00 +00:00
Fix off-by-one bug in string null termination (#166)
Backport withCString fix and use text version when available
This commit is contained in:
parent
52142bbf7e
commit
68e30d98ad
@ -26,28 +26,33 @@ import Data.Text.Foreign (withCStringLen)
|
|||||||
-- unliftio-core
|
-- unliftio-core
|
||||||
import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO)
|
import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO)
|
||||||
|
|
||||||
#if MIN_VERSION_text(2,0,0)
|
#if MIN_VERSION_text(2,0,1)
|
||||||
|
-- XXX: just wrap the provided combinator
|
||||||
|
|
||||||
|
import qualified Data.Text.Foreign as Text
|
||||||
|
|
||||||
|
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
|
||||||
|
withCString text action =
|
||||||
|
withUnliftIO $ \(UnliftIO unlift) ->
|
||||||
|
Text.withCString text (unlift action)
|
||||||
|
|
||||||
|
#elif MIN_VERSION_text(2,0,0)
|
||||||
|
-- XXX: the text is UTF-8, alas no withCString is available
|
||||||
|
|
||||||
import Data.Text.Foreign (lengthWord8, unsafeCopyToPtr)
|
import Data.Text.Foreign (lengthWord8, unsafeCopyToPtr)
|
||||||
import Data.Word (Word8)
|
import Data.Word (Word8)
|
||||||
import Foreign (castPtr, free, mallocBytes, pokeByteOff)
|
import Foreign (allocaBytes, castPtr, pokeByteOff)
|
||||||
import UnliftIO.Exception (bracket)
|
|
||||||
|
|
||||||
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
|
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
|
||||||
withCString t = bracket create destroy
|
withCString t@(Text _arr _off len) action =
|
||||||
where
|
withUnliftIO $ \(UnliftIO unlift) ->
|
||||||
size0 = lengthWord8 t + 1
|
allocaBytes (len + 1) $ \buf -> do
|
||||||
|
unsafeCopyToPtr t buf
|
||||||
create = liftIO $ do
|
pokeByteOff buf len (0 :: Word8)
|
||||||
ptr <- mallocBytes size0
|
unlift $ action (castPtr buf)
|
||||||
unsafeCopyToPtr t (castPtr ptr)
|
|
||||||
pokeByteOff ptr size0 (0 :: Word8)
|
|
||||||
pure ptr
|
|
||||||
|
|
||||||
destroy ptr =
|
|
||||||
liftIO $ free ptr
|
|
||||||
|
|
||||||
#else
|
#else
|
||||||
|
-- XXX: the text is UTF-16, let GHC do it
|
||||||
|
|
||||||
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
|
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
|
||||||
withCString t action = do
|
withCString t action = do
|
||||||
|
Loading…
Reference in New Issue
Block a user