{-# LANGUAGE CPP #-}

module DearImGui.Internal.Text
  ( withCString
  , withCStringOrNull
  , withCStringLen
  , withCStringEnd
  , peekCString

  , Text
  , pack
  , unpack
  ) where

-- base
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)

-- text
import Data.Text (Text, pack, unpack)
import Data.Text.Foreign (withCStringLen)

-- unliftio-core
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
  (UnliftIO m -> IO a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO ((UnliftIO m -> IO a) -> m a) -> (UnliftIO m -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \(UnliftIO forall a. m a -> IO a
unlift) ->
    IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
      TextEncoding -> String -> (CString -> IO a) -> IO a
forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
Foreign.withCString TextEncoding
utf8 (Text -> String
unpack Text
t) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
textPtr ->
        m a -> IO a
forall a. m a -> IO a
unlift (m a -> IO a) -> m a -> IO a
forall a b. (a -> b) -> a -> b
$ CString -> m a
action CString
textPtr

#endif

peekCString :: CString -> IO Text
peekCString :: CString -> IO Text
peekCString = (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
pack (IO String -> IO Text)
-> (CString -> IO String) -> CString -> IO Text
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 CString
forall a. Ptr a
nullPtr
withCStringOrNull (Just Text
s) CString -> IO a
k = Text -> (CString -> IO a) -> IO a
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 =
  (UnliftIO m -> IO a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO ((UnliftIO m -> IO a) -> m a) -> (UnliftIO m -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \(UnliftIO forall a. m a -> IO a
unlift) ->
    Text -> (CStringLen -> IO a) -> IO a
forall a. Text -> (CStringLen -> IO a) -> IO a
withCStringLen Text
t ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(CString
textPtr, Int
size) ->
      m a -> IO a
forall a. m a -> IO a
unlift (m a -> IO a) -> m a -> IO a
forall a b. (a -> b) -> a -> b
$ CString -> CString -> m a
action CString
textPtr (CString
textPtr CString -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size)