Merge branch 'main' of github.com:haskell-game/dear-imgui.hs into args

ChangeLog.md

@@ -1,7 +0,0 @@
-# Changelog for dear-imgui
-
-## [1.0.0] Initial Hackage release
-
-Based on 1.83.
-
-[1.0.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.0.0

Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -74,7 +75,7 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
 
   setNextWindowBgAlpha 0.42
 
-  begin "My Window"
+  begin Begin{ name = "My Window", isOpen = Nothing }
 
   text "Hello!"
 
@@ -112,7 +113,7 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
 
   sameLine >> arrowButton "Arrow" ImGuiDir_Up
 
-  sameLine >> checkbox "Check!" checked >>= \case
+  sameLine >> checkbox Checkbox{ label = "Check!", checked = toStateVar checked } >>= \case
     True  -> readIORef checked >>= print
     False -> return ()
 

README.md

@@ -25,7 +25,7 @@ OpenGL:
 
 ```
 package dear-imgui
-  flags: +sdl +opengl3
+  flags: +sdl +opengl
 ```
 
 With this done, the following module is the "Hello, World!" of ImGui:

cabal.project

@@ -1,3 +1,3 @@
 packages: *.cabal
 package dear-imgui
-  flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan +examples
+  flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan

dear-imgui.cabal

@@ -1,34 +1,17 @@
 cabal-version: 3.0
-
 name: dear-imgui
 version: 1.0.0
-author: Oliver Charles
-maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com
-license: BSD-3-Clause
-
-category: Graphics
-synopsis: Haskell bindings for Dear ImGui.
-description:
-  The package supports multiple rendering backends.
-  Set package flags according to your needs.
-
 build-type: Simple
-extra-source-files:
+data-files:
-  README.md,
-  ChangeLog.md,
   imgui/imgui.h
 
-source-repository head
-  type: git
-  location: https://github.com/haskell-game/dear-imgui.hs
-
 flag opengl2
   description:
     Enable OpenGL 2 backend.
   default:
     False
   manual:
-    True
+    False
 
 flag opengl3
   description:
@@ -36,7 +19,7 @@ flag opengl3
   default:
     True
   manual:
-    True
+    False
 
 flag vulkan
   description:
@@ -52,7 +35,7 @@ flag sdl
   default:
     True
   manual:
-    True
+    False
 
 flag glfw
   description:
@@ -62,14 +45,6 @@ flag glfw
   manual:
     True
 
-flag examples
-  description:
-    Build executable examples.
-  default:
-    False
-  manual:
-    True
-
 common common
   build-depends:
       base
@@ -85,7 +60,6 @@ library
     src
   exposed-modules:
     DearImGui
-    DearImGui.Raw
   other-modules:
     DearImGui.Context
     DearImGui.Enums
@@ -109,7 +83,6 @@ library
     , inline-c
     , inline-c-cpp
     , StateVar
-    , unliftio
 
   if flag(opengl2)
     exposed-modules:
@@ -124,8 +97,16 @@ library
       DearImGui.OpenGL3
     cxx-sources:
       imgui/backends/imgui_impl_opengl3.cpp
-    pkgconfig-depends:
+    if os(windows)
-      glew
+      buildable:
+        False
+    else
+      if os(darwin)
+        buildable:
+          False
+      else
+        pkgconfig-depends:
+          glew
 
   if flag(vulkan)
     exposed-modules:
@@ -202,20 +183,16 @@ library dear-imgui-generator
   build-depends:
       template-haskell
         >= 2.15 && < 2.19
-    , containers
-       ^>= 0.6.2.1
     , directory
         >= 1.3 && < 1.4
     , filepath
         >= 1.4 && < 1.5
-    , inline-c
-        >= 0.9.0.0 && < 0.10
     , megaparsec
         >= 9.0 && < 9.1
     , parser-combinators
         >= 1.2.0 && < 1.3
     , scientific
-        >= 0.3.6.2 && < 0.3.8
+        >= 0.3.6.2 && < 0.3.7
     , text
         >= 1.2.4 && < 1.3
     , th-lift
@@ -223,35 +200,27 @@ library dear-imgui-generator
     , transformers
         >= 0.5.6 && < 0.6
     , unordered-containers
-        >= 0.2.11 && < 0.2.15
+        >= 0.2.11 && < 0.2.14
 
 executable test
   import: common
   main-is: Main.hs
   default-language: Haskell2010
+  build-depends: base, sdl2, gl, dear-imgui
   ghc-options: -Wall
-  if (!flag(examples) || !flag(sdl) || !flag(opengl2))
-    buildable: False
-  else
-    build-depends: base, sdl2, gl, dear-imgui
 
 executable glfw
   main-is: Main.hs
   hs-source-dirs: examples/glfw
   default-language: Haskell2010
+  build-depends: base, GLFW-b, gl, dear-imgui, managed
   ghc-options: -Wall
-  if (!flag(examples) || !flag(glfw) || !flag(opengl2))
-    buildable: False
-  else
-    build-depends: base, GLFW-b, gl, dear-imgui, managed
 
 executable readme
   import: common
   main-is: Readme.hs
   hs-source-dirs: examples
   build-depends: sdl2, gl, dear-imgui, managed
-  if (!flag(examples) || !flag(sdl) || !flag(opengl2))
-    buildable: False
 
 executable vulkan
   import: common
@@ -259,33 +228,30 @@ executable vulkan
   other-modules: Attachments, Backend, Input, Util
   hs-source-dirs: examples/vulkan
   default-language: Haskell2010
+  build-depends:
+      dear-imgui
+    , bytestring
+        >= 0.10.10.0 && < 0.12
+    , containers
+       ^>= 0.6.2.1
+    , logging-effect
+       ^>= 1.3.12
+    , resourcet
+       ^>= 1.2.4.2
+    , sdl2
+       ^>= 2.5.3.0
+    , text-short
+       ^>= 0.1.3
+    , transformers
+       ^>= 0.5.6.2
+    , unliftio
+        >= 0.2.13 && < 0.2.15
+    , unliftio-core
+       ^>= 0.2.0.1
+    , vector
+       ^>= 0.12.1.2
+    , vulkan
+       ^>= 3.9
+    , vulkan-utils
+       ^>= 0.4.1
   ghc-options: -Wall
-  if (!flag(examples) || !flag(sdl) || !flag(vulkan))
-    buildable: False
-  else
-    build-depends:
-        dear-imgui
-      , bytestring
-          >= 0.10.10.0 && < 0.12
-      , containers
-         ^>= 0.6.2.1
-      , logging-effect
-         ^>= 1.3.12
-      , resourcet
-         ^>= 1.2.4.2
-      , sdl2
-         ^>= 2.5.3.0
-      , text-short
-         ^>= 0.1.3
-      , transformers
-         ^>= 0.5.6.2
-      , unliftio
-          >= 0.2.13 && < 0.2.19
-      , unliftio-core
-         ^>= 0.2.0.1
-      , vector
-         ^>= 0.12.1.2
-      , vulkan
-         ^>= 3.9
-      , vulkan-utils
-         ^>= 0.4.1

examples/Readme.hs

@@ -55,7 +55,7 @@ mainLoop w = do
   newFrame
 
   -- Build the GUI
-  withWindowOpen "Hello, ImGui!" do
+  bracket_ (begin Begin{ name = "Hello, ImGui!", isOpen = Nothing }) end do
     -- Add a text widget
     text "Hello, ImGui!"
 

examples/glfw/Main.hs

@@ -59,7 +59,7 @@ mainLoop win = do
     newFrame
 
     -- Build the GUI
-    bracket_ (begin "Hello, ImGui!") end do
+    bracket_ (begin Begin{ name = "Hello, ImGui!", isOpen = Nothing }) end do
       -- Add a text widget
       text "Hello, ImGui!"
 

generator/DearImGui/Generator.hs

@@ -6,33 +6,21 @@
 {-# LANGUAGE TemplateHaskell #-}
 
 module DearImGui.Generator
-  ( declareEnumerations, enumerationsTypesTable )
+  ( declareEnumerations )
   where
 
 -- base
-import Control.Arrow
-  ( second )
 import Data.Coerce
   ( coerce )
 import Data.Bits
   ( Bits )
 import Data.Foldable
   ( toList )
-import qualified Data.List.NonEmpty as NonEmpty
-  ( head )
-import Data.String
-  ( fromString )
 import Data.Traversable
   ( for )
 import Foreign.Storable
   ( Storable )
 
--- containers
-import Data.Map.Strict
-  ( Map )
-import qualified Data.Map.Strict as Map
-  ( fromList )
-
 -- directory
 import System.Directory
   ( canonicalizePath )
@@ -41,12 +29,9 @@ import System.Directory
 import System.FilePath
   ( takeDirectory )
 
--- inline-c
-import qualified Language.C.Types as InlineC
-  ( TypeSpecifier(TypeName) )
-
 -- megaparsec
 import qualified Text.Megaparsec as Megaparsec
+  ( ParseErrorBundle(bundleErrors), parse, parseErrorPretty )
 
 -- template-haskell
 import qualified Language.Haskell.TH        as TH
@@ -62,68 +47,53 @@ import qualified Data.Text.IO as Text
 import qualified DearImGui.Generator.Parser as Parser
   ( headers )
 import DearImGui.Generator.Tokeniser
-  ( Tok, tokenise )
+  ( tokenise )
 import DearImGui.Generator.Types
-  ( Comment(..), Enumeration(..), Headers(..)
+  ( Comment(..), Enumeration(..), Headers(..) )
-  , generateNames
-  )
 
 --------------------------------------------------------------------------------
 -- Obtaining parsed header data.
 
-headers :: Headers ( TH.Name, TH.Name )
+headers :: Headers
 headers = $( do
   currentPath <- TH.loc_filename <$> TH.location
-  basicHeaders <- TH.runIO do
+  TH.lift =<< TH.runIO do
     headersPath  <- canonicalizePath ( takeDirectory currentPath <> "/../../imgui/imgui.h" )
     headersSource <- Text.readFile headersPath
     tokens <- case tokenise headersSource of
       Left  err  -> error ( "Couldn't tokenise Dear ImGui headers:\n\n" <> show err )
       Right toks -> pure toks
     case Megaparsec.parse Parser.headers "" tokens of
-      Left  err -> do
+      Left  err -> error $
-        let
+        "Couldn't parse Dear ImGui headers:\n\n" <>
-          errorPos :: Int
+        ( unlines ( map Megaparsec.parseErrorPretty . toList $ Megaparsec.bundleErrors err ) )
-          errorPos = Megaparsec.errorOffset . NonEmpty.head $ Megaparsec.bundleErrors err
-          prev, rest :: [ Tok ]
-          ( prev, rest ) = second ( take 15 ) . splitAt 5 . drop ( errorPos - 5 ) $ tokens
-        error $
-          "Couldn't parse Dear ImGui headers:\n\n" <>
-          ( unlines ( map Megaparsec.parseErrorPretty . toList $ Megaparsec.bundleErrors err ) ) <> "\n" <>
-          ( unlines ( map show prev ) <> "\n\n" <> unlines ( map show rest ) )
       Right res -> pure res
-  TH.lift $ generateNames basicHeaders
   )
 
 --------------------------------------------------------------------------------
 -- Generating TH splices.
 
-enumerationsTypesTable :: Map InlineC.TypeSpecifier ( TH.Q TH.Type )
-enumerationsTypesTable = Map.fromList . map mkTypePair $ enums headers
-  where
-    mkTypePair :: Enumeration ( TH.Name, TH.Name ) -> ( InlineC.TypeSpecifier, TH.Q TH.Type )
-    mkTypePair ( Enumeration { enumName, enumTypeName } ) =
-      ( InlineC.TypeName $ fromString ( Text.unpack enumName )
-      , TH.conT ( fst $ enumTypeName )
-      )
-
 declareEnumerations :: TH.Name -> TH.Name -> TH.Q [ TH.Dec ]
 declareEnumerations finiteEnumName countName = do
   concat <$> mapM ( declareEnumeration finiteEnumName countName ) ( enums headers )
 
-declareEnumeration :: TH.Name -> TH.Name -> Enumeration ( TH.Name, TH.Name ) -> TH.Q [ TH.Dec ]
+declareEnumeration :: TH.Name -> TH.Name -> Enumeration -> TH.Q [ TH.Dec ]
 declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
   let
-    tyName, conName :: TH.Name
+    enumNameStr :: String
-    ( tyName, conName ) = enumTypeName
+    enumNameStr = Text.unpack enumName
     isFlagEnum :: Bool
     isFlagEnum = "Flags" `Text.isInfixOf` enumName
+  tyName  <- TH.newName enumNameStr
+
+  conName <- TH.newName enumNameStr
+  let
     newtypeCon :: TH.Q TH.Con
     newtypeCon =
       TH.normalC conName
         [ TH.bangType
           ( TH.bang TH.noSourceUnpackedness TH.noSourceStrictness )
-          ( TH.conT underlyingType )
+          ( TH.conT enumType )
         ]
     classes :: [ TH.Q TH.Type ]
     classes
@@ -133,15 +103,14 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
       = map TH.conT [ ''Eq, ''Ord, ''Storable ]
     derivClause :: TH.Q TH.DerivClause
     derivClause = TH.derivClause ( Just TH.NewtypeStrategy ) classes
-
   newtypeDecl <-
-#if MIN_VERSION_template_haskell(2,18,0)
+#if MIN_VERSION_base(4,16,0)
     ( if   null docs
       then TH.newtypeD
       else
         \ ctx name bndrs kd con derivs ->
-          TH.newtypeD_doc ctx name ( fmap pure bndrs ) ( fmap pure kd ) ( con, Nothing, [] ) derivs
+          TH.newtypeD_doc ctx name ( fmap pure bndrs ) ( fmap pure kd ) ( con, "", [] ) derivs
-            ( Just . Text.unpack . Text.unlines . coerce $ docs )
+            ( Text.unpack . Text.unlines . coerce $ docs )
     )
 #else
     TH.newtypeD
@@ -168,13 +137,13 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
     patName   <- TH.newName patNameStr
     patSynSig <- TH.patSynSigD patName ( TH.conT tyName )
     pat       <-
-#if MIN_VERSION_template_haskell(2,18,0)
+#if MIN_VERSION_base(4,16,0)
       ( if   Text.null patDoc
         then TH.patSynD
         else
           \ nm args dir pat ->
           TH.patSynD_doc nm args dir pat
-            ( Just $ Text.unpack patDoc ) []
+            ( Text.unpack patDoc ) []
       )
 #else
       TH.patSynD

generator/DearImGui/Generator/Parser.hs

@@ -75,7 +75,7 @@ import Data.HashMap.Strict
 import qualified Data.HashMap.Strict as HashMap
   ( fromList, insert, lookup )
 
--- dear-imgui-generator
+-- dear-imgui-generator 
 import DearImGui.Generator.Tokeniser
   ( Tok(..) )
 import DearImGui.Generator.Types
@@ -111,46 +111,27 @@ instance ShowErrorComponent CustomParseError where
 --------------------------------------------------------------------------------
 -- Parsing headers.
 
-headers :: MonadParsec CustomParseError [Tok] m => m ( Headers () )
+headers :: MonadParsec CustomParseError [Tok] m => m Headers
 headers = do
   _ <- skipManyTill anySingle ( namedSection "Header mess" )
-
   _ <- skipManyTill anySingle ( namedSection "Forward declarations" )
   ( _structNames, enumNamesAndTypes ) <- forwardDeclarations
-
   _ <- skipManyTill anySingle ( namedSection "Dear ImGui end-user API functions" )
-
   _ <- skipManyTill anySingle ( namedSection "Flags & Enumerations" )
-  ( _defines, basicEnums ) <- partitionEithers <$>
+  ( _defines, enums ) <- partitionEithers <$>
     manyTill
       (   ( Left  <$> try ignoreDefine )
       <|> ( Right <$> enumeration enumNamesAndTypes )
       )
       ( namedSection "Helpers: Memory allocations macros, ImVector<>" )
-
   _ <- skipManyTill anySingle ( namedSection "ImGuiStyle" )
-
   _ <- skipManyTill anySingle ( namedSection "ImGuiIO" )
-
   _ <- skipManyTill anySingle ( namedSection "Misc data structures" )
+  _ <- skipManyTill anySingle ( namedSection "Obsolete functions" )
+  _ <- skipManyTill anySingle ( namedSection "Helpers" )
+  _ <- skipManyTill anySingle ( namedSection "Drawing API" )
+  _ <- skipManyTill anySingle ( namedSection "Font API" )
 
-  _ <- skipManyTill anySingle ( namedSection "Helpers (ImGuiOnceUponAFrame, ImGuiTextFilter, ImGuiTextBuffer, ImGuiStorage, ImGuiListClipper, ImColor)" )
-
-  _ <- skipManyTill anySingle ( namedSection "Drawing API (ImDrawCmd, ImDrawIdx, ImDrawVert, ImDrawChannel, ImDrawListSplitter, ImDrawListFlags, ImDrawList, ImDrawData)" )
-  skipManyTill anySingle ( try . lookAhead $ many comment *> keyword "enum" )
-  drawingEnums <- many ( enumeration enumNamesAndTypes )
-
-  _ <- skipManyTill anySingle ( namedSection "Font API (ImFontConfig, ImFontGlyph, ImFontAtlasFlags, ImFontAtlas, ImFontGlyphRangesBuilder, ImFont)" )
-  skipManyTill anySingle ( try . lookAhead $ many comment *> keyword "enum" )
-  fontEnums <- many ( enumeration enumNamesAndTypes )
-
-  _ <- skipManyTill anySingle ( namedSection "Viewports" )
-
-  _ <- skipManyTill anySingle ( namedSection "Obsolete functions and types" )
-
-  let
-    enums :: [ Enumeration () ]
-    enums = basicEnums <> drawingEnums <> fontEnums
   pure ( Headers { enums } )
 
 --------------------------------------------------------------------------------
@@ -170,7 +151,7 @@ forwardDeclarations = do
   _ <- many comment
   enums <- many do
     keyword "typedef"
-    ty <- cTypeName
+    ty <- enumTypeName
     enumName <- identifier
     reservedSymbol ';'
     doc <- commentText <$> comment
@@ -178,8 +159,8 @@ forwardDeclarations = do
   -- Stopping after simple structs and enums for now.
   pure ( HashMap.fromList structs, HashMap.fromList enums )
 
-cTypeName :: MonadParsec e [Tok] m => m TH.Name
+enumTypeName :: MonadParsec e [Tok] m => m TH.Name
-cTypeName = keyword "int" $> ''CInt
+enumTypeName = keyword "int" $> ''CInt
 
 --------------------------------------------------------------------------------
 -- Parsing enumerations.
@@ -191,26 +172,22 @@ data EnumState = EnumState
   , hasExplicitCount :: Bool
   }
 
-enumeration :: MonadParsec CustomParseError [Tok] m => HashMap Text ( TH.Name, Comment ) -> m ( Enumeration () )
+enumeration :: MonadParsec CustomParseError [Tok] m => HashMap Text ( TH.Name, Comment ) -> m Enumeration
 enumeration enumNamesAndTypes = do
-  inlineDocs <- try do
+  inlineDocs <- many comment
-    inlineDocs <- many comment
+  keyword "enum"
-    keyword "enum"
-    pure inlineDocs
   fullEnumName <- identifier
   let
     enumName :: Text
     enumName = Text.dropWhileEnd ( == '_' ) fullEnumName
-    enumTypeName :: ()
+  ( enumType, forwardDoc ) <- case HashMap.lookup enumName enumNamesAndTypes of
-    enumTypeName = ()
-  ( underlyingType, forwardDoc ) <- case HashMap.lookup enumName enumNamesAndTypes of
     Just res -> pure res
     Nothing  -> customFailure ( MissingForwardDeclaration { enumName } )
   let
     docs :: [Comment]
     docs = forwardDoc : CommentText "" : inlineDocs
   reservedSymbol '{'
-  ( patterns, EnumState { enumSize, hasExplicitCount } ) <-
+  ( patterns, EnumState { enumSize, hasExplicitCount } ) <- 
     ( `runStateT` EnumState { enumValues = mempty, currEnumTag = 0, enumSize = 0, hasExplicitCount = False } ) $
       catMaybes
           <$> many
@@ -245,11 +222,11 @@ patternNameAndValue
 patternNameAndValue enumName =
   try do
       sz <- count
-      modify' ( \ ( EnumState {..} ) -> EnumState { enumSize = sz, hasExplicitCount = True, .. } )
+      modify' ( ( \ st -> st { enumSize = sz, hasExplicitCount = True } ) :: EnumState -> EnumState )
       pure Nothing
   <|> do
         pat@( _, val ) <- value
-        modify' ( \ ( EnumState {..} ) -> EnumState { enumSize = enumSize + 1, currEnumTag = val + 1, .. } )
+        modify' ( \ st -> st { enumSize = ( enumSize :: EnumState -> Integer ) st + 1, currEnumTag = val + 1} )
         pure ( Just pat )
   where
     count :: StateT EnumState m Integer

generator/DearImGui/Generator/Types.hs

@@ -1,27 +1,19 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 
 module DearImGui.Generator.Types where
 
--- base
-import Data.Functor
-  ( (<&>) )
-
 -- template-haskell
-import qualified Language.Haskell.TH        as TH
 import qualified Language.Haskell.TH.Syntax as TH
+  ( Lift(..), Name(..) )
 
 -- text
 import Data.Text
   ( Text )
-import qualified Data.Text as Text
-  ( unpack )
 
 -- th-lift
 import Language.Haskell.TH.Lift
@@ -33,33 +25,18 @@ newtype Comment = CommentText { commentText :: Text }
   deriving stock   ( Show, TH.Lift )
   deriving newtype ( Eq, Ord )
 
-data Enumeration typeName
+data Enumeration
   = Enumeration
   { docs             :: ![Comment]
   , enumName         :: !Text
-  , enumTypeName     :: !typeName
   , enumSize         :: !Integer
-  , underlyingType   :: !TH.Name
+  , enumType         :: !TH.Name
   , hasExplicitCount :: !Bool
   , patterns         :: [ ( Text, Integer, Comment ) ]
   }
   deriving stock ( Show, TH.Lift )
 
-data Headers typeName
+data Headers
   = Headers
-  { enums :: [ Enumeration typeName ] }
+  { enums :: [ Enumeration ] }
   deriving stock ( Show, TH.Lift )
-
-generateNames :: Headers () -> Headers ( TH.Name, TH.Name )
-generateNames ( Headers { enums = basicEnums } ) = Headers { enums = namedEnums }
-  where
-    namedEnums :: [ Enumeration ( TH.Name, TH.Name ) ]
-    namedEnums = basicEnums <&> \ enum@( Enumeration { enumName } ) ->
-      let
-        enumNameStr :: String
-        enumNameStr = Text.unpack enumName
-        tyName, conName :: TH.Name
-        tyName  = TH.mkName enumNameStr
-        conName = TH.mkName enumNameStr
-      in
-        enum { enumTypeName = ( tyName, conName ) }

src/DearImGui/Context.hs

@@ -18,19 +18,21 @@ import Language.C.Types
   ( pattern TypeName )
 
 -- dear-imgui
+import DearImGui.Enums
 import DearImGui.Structs
 
--- dear-imgui-generator
-import DearImGui.Generator
-  ( enumerationsTypesTable )
-
 --------------------------------------------------------------------------------
 
 imguiContext :: Context
 imguiContext = mempty
-  { ctxTypesTable = enumerationsTypesTable <>
+  { ctxTypesTable = Map.fromList
-    Map.fromList
+      [ ( TypeName "ImGuiCol" , [t| ImGuiCol |] )
-      [ ( TypeName "ImVec2", [t| ImVec2 |] )
+      , ( TypeName "ImGuiCond", [t| ImGuiCond |] )
+      , ( TypeName "ImGuiDir" , [t| ImGuiDir |] )
+      , ( TypeName "ImGuiStyleVar"    , [t| ImGuiStyleVar |] )
+      , ( TypeName "ImGuiTabBarFlags" , [t| ImGuiTabBarFlags |] )
+      , ( TypeName "ImGuiTabItemFlags", [t| ImGuiTabItemFlags |] )
+      , ( TypeName "ImVec2", [t| ImVec2 |] )
       , ( TypeName "ImVec3", [t| ImVec3 |] )
       , ( TypeName "ImVec4", [t| ImVec4 |] )
       ]

src/DearImGui/Vulkan.hs

@@ -12,8 +12,6 @@ Vulkan backend for Dear ImGui.
 module DearImGui.Vulkan
   ( InitInfo(..)
   , withVulkan
-  , vulkanInit
-  , vulkanShutdown
   , vulkanNewFrame
   , vulkanRenderDrawData
   , vulkanCreateFontsTexture
@@ -30,7 +28,7 @@ import Data.Word
 import Foreign.Marshal.Alloc
   ( alloca )
 import Foreign.Ptr
-  ( FunPtr, Ptr, freeHaskellFunPtr, nullPtr )
+  ( Ptr, freeHaskellFunPtr, nullPtr )
 import Foreign.Storable
   ( Storable(poke) )
 
@@ -85,18 +83,7 @@ data InitInfo =
 
 -- | Wraps @ImGui_ImplVulkan_Init@ and @ImGui_ImplVulkan_Shutdown@.
 withVulkan :: MonadUnliftIO m => InitInfo -> Vulkan.RenderPass -> ( Bool -> m a ) -> m a
-withVulkan initInfo renderPass action =
+withVulkan ( InitInfo {..} ) renderPass action = do
-  bracket
-    ( vulkanInit initInfo renderPass )
-    vulkanShutdown
-    ( \ ( _, initResult ) -> action initResult )
-
--- | Wraps @ImGui_ImplVulkan_Init@.
--- 
--- Use 'vulkanShutdown' to clean up on shutdown.
--- Prefer using 'withVulkan' when possible, as it automatically handles cleanup.
-vulkanInit :: MonadIO m => InitInfo -> Vulkan.RenderPass -> m (FunPtr (Vulkan.Result -> IO ()), Bool)
-vulkanInit ( InitInfo {..} ) renderPass = do
   let
     instancePtr :: Ptr Vulkan.Instance_T
     instancePtr = Vulkan.instanceHandle instance'
@@ -110,39 +97,38 @@ vulkanInit ( InitInfo {..} ) renderPass = do
     withCallbacks f = case mbAllocator of
       Nothing        -> f nullPtr
       Just callbacks -> alloca ( \ ptr -> poke ptr callbacks *> f ptr )
-  liftIO do
+  bracket
-    checkResultFunPtr <- $( C.mkFunPtr [t| Vulkan.Result -> IO () |] ) checkResult
+    ( liftIO do
-    initResult <- withCallbacks \ callbacksPtr ->
+        checkResultFunPtr <- $( C.mkFunPtr [t| Vulkan.Result -> IO () |] ) checkResult
-        [C.block| bool {
+        initResult <- withCallbacks \ callbacksPtr ->
-          ImGui_ImplVulkan_InitInfo initInfo;
+            [C.block| bool {
-          VkInstance instance = { $( VkInstance_T* instancePtr ) };
+              ImGui_ImplVulkan_InitInfo initInfo;
-          initInfo.Instance = instance;
+              VkInstance instance = { $( VkInstance_T* instancePtr ) };
-          VkPhysicalDevice physicalDevice = { $( VkPhysicalDevice_T* physicalDevicePtr ) };
+              initInfo.Instance = instance;
-          initInfo.PhysicalDevice = physicalDevice;
+              VkPhysicalDevice physicalDevice = { $( VkPhysicalDevice_T* physicalDevicePtr ) };
-          VkDevice device = { $( VkDevice_T* devicePtr ) };
+              initInfo.PhysicalDevice = physicalDevice;
-          initInfo.Device = device;
+              VkDevice device = { $( VkDevice_T* devicePtr ) };
-          initInfo.QueueFamily = $(uint32_t queueFamily);
+              initInfo.Device = device;
-          VkQueue queue = { $( VkQueue_T* queuePtr ) };
+              initInfo.QueueFamily = $(uint32_t queueFamily);
-          initInfo.Queue = queue;
+              VkQueue queue = { $( VkQueue_T* queuePtr ) };
-          initInfo.PipelineCache = $(VkPipelineCache pipelineCache);
+              initInfo.Queue = queue;
-          initInfo.DescriptorPool = $(VkDescriptorPool descriptorPool);
+              initInfo.PipelineCache = $(VkPipelineCache pipelineCache);
-          initInfo.Subpass = $(uint32_t subpass);
+              initInfo.DescriptorPool = $(VkDescriptorPool descriptorPool);
-          initInfo.MinImageCount = $(uint32_t minImageCount);
+              initInfo.Subpass = $(uint32_t subpass);
-          initInfo.ImageCount = $(uint32_t imageCount);
+              initInfo.MinImageCount = $(uint32_t minImageCount);
-          initInfo.MSAASamples = $(VkSampleCountFlagBits msaaSamples);
+              initInfo.ImageCount = $(uint32_t imageCount);
-          initInfo.Allocator = $(VkAllocationCallbacks* callbacksPtr);
+              initInfo.MSAASamples = $(VkSampleCountFlagBits msaaSamples);
-          initInfo.CheckVkResultFn = $( void (*checkResultFunPtr)(VkResult) );
+              initInfo.Allocator = $(VkAllocationCallbacks* callbacksPtr);
-          return ImGui_ImplVulkan_Init(&initInfo, $(VkRenderPass renderPass) );
+              initInfo.CheckVkResultFn = $( void (*checkResultFunPtr)(VkResult) );
-        }|]
+              return ImGui_ImplVulkan_Init(&initInfo, $(VkRenderPass renderPass) );
-    pure ( checkResultFunPtr, initResult /= 0 )
+            }|]
-
+        pure ( checkResultFunPtr, initResult /= 0 )
--- | Wraps @ImGui_ImplVulkan_Shutdown@.
+    )
---
+    ( \ ( checkResultFunPtr, _ ) -> liftIO do
--- Counterpart to 'vulkanInit', for clean-up.
+      [C.exp| void { ImGui_ImplVulkan_Shutdown(); } |]
-vulkanShutdown :: MonadIO m => (FunPtr a, b) -> m ()
+      freeHaskellFunPtr checkResultFunPtr
-vulkanShutdown ( checkResultFunPtr, _ ) = liftIO do
+    )
-  [C.exp| void { ImGui_ImplVulkan_Shutdown(); } |]
+    ( \ ( _, initResult ) -> action initResult )
-  freeHaskellFunPtr checkResultFunPtr
 
 -- | Wraps @ImGui_ImplVulkan_NewFrame@.
 vulkanNewFrame :: MonadIO m => m ()