{-# LANGUAGE CPP #-}
module DearImGui.Internal.Text
( withCString
, withCStringOrNull
, withCStringLen
, withCStringEnd
, peekCString
, Text
, pack
, unpack
) where
import Control.Monad.IO.Class (liftIO)
import Foreign (nullPtr, plusPtr)
import Foreign.C.String (CString)
import qualified GHC.Foreign as Foreign
import System.IO (utf8)
import Data.Text (Text, pack, unpack)
import Data.Text.Foreign (withCStringLen)
import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO)
#if MIN_VERSION_text(2,0,0)
import Data.Text.Foreign (lengthWord8, unsafeCopyToPtr)
import Data.Word (Word8)
import Foreign (castPtr, free, mallocBytes, pokeByteOff)
import UnliftIO.Exception (bracket)
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString t = bracket create destroy
where
size0 = lengthWord8 t + 1
create = liftIO $ do
ptr <- mallocBytes size0
unsafeCopyToPtr t (castPtr ptr)
pokeByteOff ptr size0 (0 :: Word8)
pure ptr
destroy ptr =
liftIO $ free ptr
#else
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> (CString -> m a) -> m a
withCString Text
t CString -> m a
action = do
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO forall a b. (a -> b) -> a -> b
$ \(UnliftIO forall a. m a -> IO a
unlift) ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
Foreign.withCString TextEncoding
utf8 (Text -> String
unpack Text
t) forall a b. (a -> b) -> a -> b
$ \CString
textPtr ->
forall a. m a -> IO a
unlift forall a b. (a -> b) -> a -> b
$ CString -> m a
action CString
textPtr
#endif
peekCString :: CString -> IO Text
peekCString :: CString -> IO Text
peekCString = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> CString -> IO String
Foreign.peekCString TextEncoding
utf8
withCStringOrNull :: Maybe Text -> (CString -> IO a) -> IO a
withCStringOrNull :: forall a. Maybe Text -> (CString -> IO a) -> IO a
withCStringOrNull Maybe Text
Nothing CString -> IO a
k = CString -> IO a
k forall a. Ptr a
nullPtr
withCStringOrNull (Just Text
s) CString -> IO a
k = forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> (CString -> m a) -> m a
withCString Text
s CString -> IO a
k
withCStringEnd :: MonadUnliftIO m => Text -> (CString -> CString -> m a) -> m a
withCStringEnd :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> (CString -> CString -> m a) -> m a
withCStringEnd Text
t CString -> CString -> m a
action =
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO forall a b. (a -> b) -> a -> b
$ \(UnliftIO forall a. m a -> IO a
unlift) ->
forall a. Text -> (CStringLen -> IO a) -> IO a
withCStringLen Text
t forall a b. (a -> b) -> a -> b
$ \(CString
textPtr, Int
size) ->
forall a. m a -> IO a
unlift forall a b. (a -> b) -> a -> b
$ CString -> CString -> m a
action CString
textPtr (CString
textPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size)