Handle remaining enums (#36)

This handles the remaining enum types in the headers that aren't in the enums section.

It also automatically handles adding all the enumerations to the inline-c context types table, and a small improvement to the display of parse error messages.

generator/DearImGui/Generator/Parser.hs

@@ -111,27 +111,44 @@ 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, enums ) <- partitionEithers <$>
+  ( _defines, basicEnums ) <- 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 "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 ( try . lookAhead $ many comment *> keyword "enum" )
+  drawingEnums <- many ( enumeration enumNamesAndTypes )
+
+  _ <- skipManyTill anySingle ( namedSection "Font API" )
+  skipManyTill anySingle ( try . lookAhead $ many comment *> keyword "enum" )
+  fontEnums <- many ( enumeration enumNamesAndTypes )
+
+  let
+    enums :: [ Enumeration () ]
+    enums = basicEnums <> drawingEnums <> fontEnums
   pure ( Headers { enums } )
 
 --------------------------------------------------------------------------------
@@ -151,7 +168,7 @@ forwardDeclarations = do
   _ <- many comment
   enums <- many do
     keyword "typedef"
-    ty <- enumTypeName
+    ty <- cTypeName
     enumName <- identifier
     reservedSymbol ';'
     doc <- commentText <$> comment
@@ -159,8 +176,8 @@ forwardDeclarations = do
   -- Stopping after simple structs and enums for now.
   pure ( HashMap.fromList structs, HashMap.fromList enums )
 
-enumTypeName :: MonadParsec e [Tok] m => m TH.Name
-enumTypeName = keyword "int" $> ''CInt
+cTypeName :: MonadParsec e [Tok] m => m TH.Name
+cTypeName = keyword "int" $> ''CInt
 
 --------------------------------------------------------------------------------
 -- Parsing enumerations.
@@ -172,15 +189,19 @@ 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 <- many comment
-  keyword "enum"
+  inlineDocs <- try do
+    inlineDocs <- many comment
+    keyword "enum"
+    pure inlineDocs
   fullEnumName <- identifier
   let
     enumName :: Text
     enumName = Text.dropWhileEnd ( == '_' ) fullEnumName
-  ( enumType, forwardDoc ) <- case HashMap.lookup enumName enumNamesAndTypes of
+    enumTypeName :: ()
+    enumTypeName = ()
+  ( underlyingType, forwardDoc ) <- case HashMap.lookup enumName enumNamesAndTypes of
     Just res -> pure res
     Nothing  -> customFailure ( MissingForwardDeclaration { enumName } )
   let

generator/DearImGui/Generator/Types.hs

@@ -1,19 +1,27 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 
 module DearImGui.Generator.Types where
 
+-- base
+import Data.Traversable
+  ( for )
+
 -- 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
@@ -25,18 +33,30 @@ newtype Comment = CommentText { commentText :: Text }
   deriving stock   ( Show, TH.Lift )
   deriving newtype ( Eq, Ord )
 
-data Enumeration
+data Enumeration typeName
   = Enumeration
   { docs             :: ![Comment]
   , enumName         :: !Text
+  , enumTypeName     :: !typeName
   , enumSize         :: !Integer
-  , enumType         :: !TH.Name
+  , underlyingType   :: !TH.Name
   , hasExplicitCount :: !Bool
   , patterns         :: [ ( Text, Integer, Comment ) ]
   }
   deriving stock ( Show, TH.Lift )
 
-data Headers
+data Headers typeName
   = Headers
-  { enums :: [ Enumeration ] }
+  { enums :: [ Enumeration typeName ] }
   deriving stock ( Show, TH.Lift )
+
+generateNames :: Headers () -> TH.Q ( Headers ( TH.Name, TH.Name ) )
+generateNames ( Headers { enums = basicEnums } ) = do
+  enums <- for basicEnums \ enum@( Enumeration { enumName } ) -> do
+    let
+      enumNameStr :: String
+      enumNameStr = Text.unpack enumName
+    tyName  <- TH.newName enumNameStr
+    conName <- TH.newName enumNameStr
+    pure $ enum { enumTypeName = ( tyName, conName ) }
+  pure $ Headers { enums }