Replace String arguments with Text (#138)

Shave a few allocations and pointer-chasing due to conversion.

Main.hs

@@ -10,6 +10,7 @@ import Data.IORef
 import qualified Data.Vector as Vector
 import DearImGui
 import DearImGui.OpenGL3
+import DearImGui.Internal.Text (pack)
 import DearImGui.SDL
 import DearImGui.SDL.OpenGL
 import Control.Exception
@@ -134,18 +135,18 @@ loop window checked color slider r pos size' selected tab1Ref tab2Ref = do
 
   text "ListClipper"
   withChildOpen "##fixed" (ImVec2 0 200) True ImGuiWindowFlags_None do
-    let lotsOfItems = Vector.generate 50 (mappend "Item " . show)
+    let lotsOfItems = Vector.generate 50 (pack . mappend "Item " . show)
     withListClipper Nothing lotsOfItems text
 
   text "ListClipper, Haskell-powered"
   withChildOpen "##infinite" (ImVec2 0 200) True ImGuiWindowFlags_None do
-    let infiniteItems = map (mappend "Item " . show) [0 :: Int ..]
+    let infiniteItems = map (pack . mappend "Item " . show) [0 :: Int ..]
     withListClipper Nothing infiniteItems text
 
   text "Ethereal ListClipper"
   withChildOpen "##ethereal" (ImVec2 0 200) True ImGuiWindowFlags_None do
     withListClipper Nothing (ClipRange (0 :: Int) 1000) $
-      text . mappend "Item " . show
+      text . pack . mappend "Item " . show
 
   plotHistogram "A histogram" [ 10, 10, 20, 30, 90 ]
 

dear-imgui.cabal

@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name: dear-imgui
-version: 1.5.0
+version: 2.0.0
 author: Oliver Charles
 maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com
 license: BSD-3-Clause
@@ -140,13 +140,14 @@ library
   exposed-modules:
     DearImGui
     DearImGui.FontAtlas
+    DearImGui.Internal.Text
     DearImGui.Raw
     DearImGui.Raw.DrawList
     DearImGui.Raw.Font
     DearImGui.Raw.Font.Config
     DearImGui.Raw.Font.GlyphRanges
-    DearImGui.Raw.ListClipper
     DearImGui.Raw.IO
+    DearImGui.Raw.ListClipper
   other-modules:
     DearImGui.Context
     DearImGui.Enums
@@ -171,6 +172,7 @@ library
     , StateVar
     , unliftio
     , vector
+    , text
 
   if flag(disable-obsolete)
     cxx-options: -DIMGUI_DISABLE_OBSOLETE_FUNCTIONS
@@ -286,7 +288,7 @@ library dear-imgui-generator
     , scientific
         >= 0.3.6.2 && < 0.3.8
     , text
-        >= 1.2.4 && < 1.3
+        >= 1.2.4 && < 2.1
     , th-lift
         >= 0.7 && < 0.9
     , transformers
@@ -308,10 +310,10 @@ executable glfw
   main-is: Main.hs
   hs-source-dirs: examples/glfw
   default-language: Haskell2010
-  if (!flag(examples) || !flag(glfw) || !flag(opengl2))
+  if (!flag(examples) || !flag(glfw) || !flag(opengl3))
     buildable: False
   else
-    build-depends: base, GLFW-b, gl, dear-imgui, managed
+    build-depends: base, GLFW-b, gl, dear-imgui, managed, text
 
 executable readme
   import: common, exe-flags

examples/glfw/Main.hs

@@ -13,6 +13,7 @@ import Data.Bits ((.|.))
 import Data.IORef
 import Data.List (sortBy)
 import Data.Foldable (traverse_)
+import Data.Text (Text, pack)
 
 import DearImGui
 import DearImGui.OpenGL2
@@ -61,7 +62,7 @@ main = do
 
   GLFW.terminate
 
-mainLoop :: Window -> IORef [(Integer, String)] -> IO ()
+mainLoop :: Window -> IORef [(Integer, Text)] -> IO ()
 mainLoop win tableRef = do
   -- Process the event loop
   GLFW.pollEvents
@@ -102,7 +103,7 @@ mainLoop win tableRef = do
 
     mainLoop win tableRef
 
-mkTable :: IORef [(Integer, String)] -> IO ()
+mkTable :: IORef [(Integer, Text)] -> IO ()
 mkTable tableRef =
   withTableOpen sortable "MyTable" 3 $ do
     tableSetupColumn "Hello"
@@ -120,7 +121,7 @@ mkTable tableRef =
     readIORef tableRef >>=
       traverse_ \(ix, title) -> do
         tableNextRow
-        tableNextColumn $ text (show ix)
+        tableNextColumn $ text (pack $ show ix)
         tableNextColumn $ text title
         tableNextColumn $ void (button "♥")
   where

src/DearImGui/Internal/Text.hs

@@ -0,0 +1,72 @@
+{-# 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 t action = do
+  withUnliftIO $ \(UnliftIO unlift) ->
+    liftIO $
+      Foreign.withCString utf8 (unpack t) $ \textPtr ->
+        unlift $ action textPtr
+
+#endif
+
+peekCString :: CString -> IO Text
+peekCString = fmap pack . Foreign.peekCString utf8
+
+withCStringOrNull :: Maybe Text -> (CString -> IO a) -> IO a
+withCStringOrNull Nothing k  = k nullPtr
+withCStringOrNull (Just s) k = withCString s k
+
+withCStringEnd :: MonadUnliftIO m => Text -> (CString -> CString -> m a) -> m a
+withCStringEnd t action =
+  withUnliftIO $ \(UnliftIO unlift) ->
+    withCStringLen t $ \(textPtr, size) ->
+      unlift $ action textPtr (textPtr `plusPtr` size)