Parse enums from headers & generate code (#19)

src/DearImGui.hs

@@ -122,13 +122,8 @@ module DearImGui
   , isItemHovered
 
     -- * Types
-  , ImGuiDir
-  , pattern ImGuiDirLeft
-  , pattern ImGuiDirRight
-  , pattern ImGuiDirUp
-  , pattern ImGuiDirDown
-  , ImVec3(..)
-  , ImVec4(..)
+  , module DearImGui.Enums
+  , module DearImGui.Structs
   )
   where
 
@@ -139,6 +134,9 @@ import Foreign.C
 
 -- dear-imgui
 import DearImGui.Context
+  ( imguiContext )
+import DearImGui.Enums
+import DearImGui.Structs
 
 -- inline-c
 import qualified Language.C.Inline as C
@@ -777,17 +775,6 @@ isItemHovered = liftIO do
   (0 /=) <$> [C.exp| bool { IsItemHovered() } |]
 
 
--- | A cardinal direction.
-newtype ImGuiDir      = ImGuiDir CInt
-
-
-pattern ImGuiDirLeft, ImGuiDirRight, ImGuiDirUp, ImGuiDirDown :: ImGuiDir
-pattern ImGuiDirLeft  = ImGuiDir 0
-pattern ImGuiDirRight = ImGuiDir 1
-pattern ImGuiDirUp    = ImGuiDir 2
-pattern ImGuiDirDown  = ImGuiDir 3
-
-
 withCStringOrNull :: Maybe String -> (Ptr CChar -> IO a) -> IO a
 withCStringOrNull Nothing k  = k nullPtr
 withCStringOrNull (Just s) k = withCString s k

src/DearImGui/Context.hs

@@ -1,57 +1,27 @@
+{-# language DerivingStrategies #-}
 {-# language DuplicateRecordFields #-}
+{-# language GeneralizedNewtypeDeriving #-}
 {-# language NamedFieldPuns #-}
 {-# language OverloadedStrings #-}
+{-# language PatternSynonyms #-}
 {-# language TemplateHaskell #-}
 
 module DearImGui.Context where
 
-import Language.C.Types
-import Language.C.Inline.Context
+-- containers
 import qualified Data.Map.Strict as Map
-import Foreign
 
+-- inline-c
+import Language.C.Inline.Context
+  ( Context(..) )
+import Language.C.Types
+  ( pattern TypeName )
 
-data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
-
-
-instance Storable ImVec3 where
-  sizeOf ~ImVec3{x, y, z} = sizeOf x + sizeOf y + sizeOf z
-
-  alignment _ = 0
-
-  poke ptr ImVec3{ x, y, z } = do
-    poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
-    poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
-    poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
-
-  peek ptr = do
-    x <- peek (castPtr ptr                         )
-    y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
-    z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
-    return ImVec3{ x, y, z }
-
-
-data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
-
-
-instance Storable ImVec4 where
-  sizeOf ~ImVec4{x, y, z, w} = sizeOf x + sizeOf y + sizeOf z + sizeOf w
-
-  alignment _ = 0
-
-  poke ptr ImVec4{ x, y, z, w } = do
-    poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
-    poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
-    poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
-    poke (castPtr ptr `plusPtr` (sizeOf x * 3)) w
-
-  peek ptr = do
-    x <- peek (castPtr ptr                         )
-    y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
-    z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
-    w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3))
-    return ImVec4{ x, y, z, w }
+-- dear-imgui
+import DearImGui.Structs
+  ( ImVec3, ImVec4 )
 
+--------------------------------------------------------------------------------
 
 imguiContext :: Context
 imguiContext = mempty

src/DearImGui/Enums.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module DearImGui.Enums where
+
+-- base
+import GHC.Exts
+  ( proxy# )
+import GHC.TypeNats
+  ( Nat, KnownNat, natVal' )
+import Numeric.Natural
+  ( Natural )
+
+-- dear-imgui-generator
+import DearImGui.Generator
+  ( declareEnumerations )
+
+--------------------------------------------------------------------------------
+
+class KnownNat ( Count a ) => FiniteEnum a where
+  type Count a :: Nat
+  count :: Natural
+  count = natVal' @( Count a ) proxy#
+
+declareEnumerations ''FiniteEnum ''Count

src/DearImGui/Structs.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module DearImGui.Structs where
+
+-- base
+import Foreign
+  ( Storable(..), castPtr, plusPtr )
+
+--------------------------------------------------------------------------------
+
+data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
+
+
+instance Storable ImVec3 where
+  sizeOf ~ImVec3{x, y, z} = sizeOf x + sizeOf y + sizeOf z
+
+  alignment _ = 0
+
+  poke ptr ImVec3{ x, y, z } = do
+    poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
+    poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
+    poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
+
+  peek ptr = do
+    x <- peek (castPtr ptr                         )
+    y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
+    z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
+    return ImVec3{ x, y, z }
+
+
+data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
+
+
+instance Storable ImVec4 where
+  sizeOf ~ImVec4{x, y, z, w} = sizeOf x + sizeOf y + sizeOf z + sizeOf w
+
+  alignment _ = 0
+
+  poke ptr ImVec4{ x, y, z, w } = do
+    poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
+    poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
+    poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
+    poke (castPtr ptr `plusPtr` (sizeOf x * 3)) w
+
+  peek ptr = do
+    x <- peek (castPtr ptr                         )
+    y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
+    z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
+    w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3))
+    return ImVec4{ x, y, z, w }