At least it compiles 😅

.gitignore

@@ -1 +1,3 @@
-/imgui.ini
+imgui.ini
+dist-newstyle
+.stack-work

.gitmodules

@@ -2,7 +2,6 @@
 	path = implot
 	url = https://github.com/epezent/implot
 	branch = v0.13
-[submodule "imgui"]
-	path = imgui
-	url = https://github.com/ocornut/imgui
-	branch = v1.87
+[submodule "dear-imgui.hs"]
+	path = dear-imgui.hs
+	url = https://github.com/haskell-game/dear-imgui.hs

README.md

@@ -6,10 +6,10 @@ This project contains Haskell bindings to the
 
 ## Contribute
 
-To build the project, make sure the subprojects:
+To build the project, make sure the subprojects are checked out recursively:
 
 ```ShellSession
-$ git submodule update --init
+$ git submodule update --init --recursive
 ```
 then
 ```ShellSession

cabal.project

@@ -1,5 +1,3 @@
 packages: *.cabal
-package dear-imgui
-  flags: -sdl +glfw
 package dear-implot
   ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind

dear-imgui.hs

@@ -0,0 +1 @@
+Subproject commit e5969f6b358dab01d9e2bea8d3538fdfbee0c2f1

dear-implot.cabal

@@ -7,6 +7,20 @@ library
   exposed-modules:
     DearImGui.Raw.Plot
     DearImGui.Plot
+  other-modules:
+    DearImGui.Plot.Generator
+    DearImGui.Plot.Generator.Parser
+    DearImGui.Plot.Context
+    DearImGui.Plot.Enums
+    DearImGui.Plot.Structs
+    --- from imgui via symlink:
+    DearImGui.Generator
+    DearImGui.Generator.Parser
+    DearImGui.Generator.Tokeniser
+    DearImGui.Generator.Types
+    DearImGui.Structs
+    DearImGui.Enums
+    DearImGui.Context
   hs-source-dirs:
     src
   default-language:
@@ -22,7 +36,7 @@ library
     stdc++
   include-dirs:
     implot
-    imgui
+    dear-imgui.hs/imgui
   build-depends: base
                , StateVar
                , containers
@@ -30,3 +44,15 @@ library
                , inline-c
                , inline-c-cpp
                , managed
+               , template-haskell
+               , directory
+               , filepath
+               , text
+               , megaparsec
+               , parser-combinators
+               , scientific
+               , unordered-containers
+               , th-lift
+               , transformers
+               , vector
+               , unliftio

imgui

@@ -1 +0,0 @@
-Subproject commit 4df57136e9832327c11e48b5bfe00b0326bd5b63

imgui

@@ -0,0 +1 @@
+dear-imgui.hs/imgui/

src/DearImGui/Context.hs

@@ -0,0 +1 @@
+../../dear-imgui.hs/src/DearImGui/Context.hs

src/DearImGui/Enums.hs

@@ -0,0 +1 @@
+../../dear-imgui.hs/src/DearImGui/Enums.hs

src/DearImGui/Generator

@@ -0,0 +1 @@
+../../dear-imgui.hs/generator/DearImGui/Generator

src/DearImGui/Generator.hs

@@ -0,0 +1 @@
+../../dear-imgui.hs/generator/DearImGui/Generator.hs

src/DearImGui/Plot.hs

@@ -26,6 +26,9 @@ module DearImGui.Plot
 
     -- * Demo so you can play with all features
   , Raw.Plot.showPlotDemoWindow
+
+    -- * TEST
+  , plotLine
   )
   where
 
@@ -72,16 +75,16 @@ import qualified Data.Vector.Unboxed as VU
 plotLine :: (MonadIO m) => String -> [Float] -> [Float] -> m ()
 plotLine label xs ys = liftIO $ do
   let size = fromIntegral $ length xs
-  withCString desc \descPtr -> do
+  withCString label \labelPtr -> do
     withArray (map realToFrac xs) \xsPtr -> do
       withArray (map realToFrac ys) \ysPtr -> do
-        Raw.Plot.plotLine label xsPtr ysPtr size
+        Raw.Plot.plotLine labelPtr xsPtr ysPtr size
 
-setNextPlotLimits :: MonadIO m => (Double, Double) -> (Double, Double) -> m ()
-setNextPlotLimits (minX, maxX) (minY, maxY) = liftIO $ do
-  Raw.Plot.setNextPlotLimits (minX', maxX') (minY', maxY')
-  where
-    minX' = realToFrac minX
-    maxX' = realToFrac maxX
-    minY' = realToFrac minY
-    maxY' = realToFrac maxY
+-- setNextPlotLimits :: MonadIO m => (Double, Double) -> (Double, Double) -> m ()
+-- setNextPlotLimits (minX, maxX) (minY, maxY) = liftIO $ do
+--   Raw.Plot.setNextPlotLimits (minX', maxX') (minY', maxY')
+--   where
+--     minX' = realToFrac minX
+--     maxX' = realToFrac maxX
+--     minY' = realToFrac minY
+--     maxY' = realToFrac maxY

src/DearImGui/Plot/Context.hs

@@ -6,7 +6,7 @@
 {-# language PatternSynonyms #-}
 {-# language TemplateHaskell #-}
 
-module DearImGui.Context where
+module DearImGui.Plot.Context where
 
 -- containers
 import qualified Data.Map.Strict as Map
@@ -17,38 +17,18 @@ import Language.C.Inline.Context
 import Language.C.Types
   ( pattern TypeName )
 
--- dear-imgui
-import DearImGui.Structs
+-- dear-implot
+import DearImGui.Plot.Structs
 
--- dear-imgui-generator
-import DearImGui.Generator
+-- dear-imgui-generator -> implot
+import DearImGui.Plot.Generator
   ( enumerationsTypesTable )
 
 --------------------------------------------------------------------------------
 
-imguiContext :: Context
-imguiContext = mempty
-  { ctxTypesTable = enumerationsTypesTable <>
-    Map.fromList
-      [ ( TypeName "ImVec2", [t| ImVec2 |] )
-      , ( TypeName "ImVec3", [t| ImVec3 |] )
-      , ( TypeName "ImVec4", [t| ImVec4 |] )
-      , ( TypeName "ImU32", [t| ImU32 |] )
-      , ( TypeName "ImGuiID", [t| ImGuiID |] )
-      , ( TypeName "ImWchar", [t| ImWchar |] )
-      , ( TypeName "ImDrawList", [t| ImDrawList |] )
-      , ( TypeName "ImGuiContext", [t| ImGuiContext |] )
-      , ( TypeName "ImFont", [t| ImFont |] )
-      , ( TypeName "ImFontConfig", [t| ImFontConfig |] )
-      , ( TypeName "ImFontGlyphRangesBuilder", [t| ImFontGlyphRangesBuilder |] )
-      , ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] )
-      , ( TypeName "ImGuiTableSortSpecs", [t| ImGuiTableSortSpecs |] )
-      ]
-  }
-
 implotContext :: Context
 implotContext = mempty
-  { ctxTypesTable =
+  { ctxTypesTable = enumerationsTypesTable <>
     Map.fromList
       [ ( TypeName "ImPlotContext", [t| ImPlotContext |] )
       ]

src/DearImGui/Plot/Enums.hs

@@ -10,7 +10,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module DearImGui.Enums where
+module DearImGui.Plot.Enums where
 
 -- base
 import GHC.Exts

src/DearImGui/Plot/Generator.hs

@@ -5,7 +5,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module DearImGui.Generator
+module DearImGui.Plot.Generator
   ( declareEnumerations, enumerationsTypesTable )
   where
 
@@ -56,8 +56,8 @@ import qualified Data.Text.IO as Text
   ( readFile )
 
 -- dear-imgui-generator
-import qualified DearImGui.Generator.Parser as Parser
-  ( headers )
+import qualified DearImGui.Plot.Generator.Parser as Parser
+  ( plotHeaders )
 import DearImGui.Generator.Tokeniser
   ( Tok, tokenise )
 import DearImGui.Generator.Types
@@ -71,33 +71,34 @@ import DearImGui.Generator.Types
 headers :: Headers ( TH.Name, TH.Name )
 headers = $( do
   currentPath <- TH.loc_filename <$> TH.location
+  let
+    patchEnums :: Text.Text -> Text.Text
+    patchEnums = Text.replace "ImGuiCond_None" "0"
+               . Text.replace "ImGuiCond_Always" "1 << 0"
+               . Text.replace "ImGuiCond_Once" "1 << 1"
   basicHeaders <- TH.runIO do
-    headersPath  <- canonicalizePath ( takeDirectory currentPath <> "/../../imgui/imgui.h" )
-    headersSource <- Text.readFile headersPath
-    tokensImGui <- case tokenise headersSource of
-      Left  err  -> error ( "Couldn't tokenise Dear ImGui headers:\n\n" <> show err )
-      Right toks -> pure toks
-    headersPath  <- canonicalizePath ( takeDirectory currentPath <> "/../../implot/implot.h" )
-    headersSource <- Text.readFile headersPath
+    headersPath  <- canonicalizePath ( takeDirectory currentPath <> "/../../../implot/implot.h" )
+    headersSource <- patchEnums <$> Text.readFile headersPath
     tokensImPlot <- case tokenise headersSource of
       Left  err  -> error ( "Couldn't tokenise Dear ImPlot headers:\n\n" <> show err )
       Right toks -> pure toks
-    let tokens = tokensImGui<>tokensImPlot
-    case Megaparsec.parse Parser.headers "" tokens of
+    case Megaparsec.parse Parser.plotHeaders "" tokensImPlot of
       Left  err -> do
         let
           errorPos :: Int
           errorPos = Megaparsec.errorOffset . NonEmpty.head $ Megaparsec.bundleErrors err
           prev, rest :: [ Tok ]
-          ( prev, rest ) = second ( take 15 ) . splitAt 5 . drop ( errorPos - 5 ) $ tokens
+          ( prev, rest ) = second ( take 15 ) . splitAt 5 . drop ( errorPos - 5 ) $ tokensImPlot
         error $
-          "Couldn't parse Dear ImGui headers:\n\n" <>
+          "Couldn't parse Dear ImPlot 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.
 

src/DearImGui/Plot/Generator/Parser.hs

@@ -0,0 +1,449 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module DearImGui.Plot.Generator.Parser
+  ( CustomParseError(..)
+  , plotHeaders
+  )
+  where
+
+-- base
+import Control.Applicative
+  ( (<|>), many, optional, some )
+import Control.Monad
+  ( void )
+import Data.Bits
+  ( Bits(shiftL) )
+import Data.Char
+  ( isSpace, toLower )
+import Data.Either
+  ( partitionEithers )
+import Data.Functor
+  ( ($>) )
+import Data.Int
+  ( Int64 )
+import Data.Maybe
+  ( catMaybes, fromMaybe )
+import Foreign.C.Types
+  ( CInt )
+
+-- template-haskell
+import qualified Language.Haskell.TH as TH
+  ( Name )
+
+-- megaparsec
+import Text.Megaparsec
+  ( MonadParsec(..)
+  , (<?>), anySingle, customFailure, single
+  )
+
+-- parser-combinators
+import Control.Applicative.Combinators
+  ( manyTill, option, sepBy1, skipManyTill )
+
+-- scientific
+import Data.Scientific
+  ( floatingOrInteger, toBoundedInteger )
+
+-- text
+import Data.Text
+  ( Text )
+import qualified Data.Text as Text
+  ( all, any, breakOn, drop, dropWhile, dropWhileEnd
+  , length, stripPrefix, unpack
+  )
+
+-- transformers
+import Control.Monad.Trans.State.Strict
+  ( StateT(..)
+  , get, modify'
+  )
+
+-- unordered-containers
+import Data.HashMap.Strict
+  ( HashMap )
+import qualified Data.HashMap.Strict as HashMap
+  ( fromList, insert, lookup )
+
+-- dear-imgui-generator
+import DearImGui.Generator.Tokeniser
+  ( Tok(..) )
+import DearImGui.Generator.Types
+  ( Comment(..), Enumeration(..), Headers(..) )
+
+import DearImGui.Generator.Parser
+
+--------------------------------------------------------------------------------
+-- Parsing headers.
+
+plotHeaders :: MonadParsec CustomParseError [Tok] m => m ( Headers () )
+plotHeaders = do
+  _ <- skipManyTill anySingle ( namedSection "Macros and Defines" )
+
+  _ <- skipManyTill anySingle ( namedSection "Enums and Types" )
+  
+  ( _structNames, enumNamesAndTypes ) <- forwardDeclarations
+  
+  ( _defines, basicEnums ) <- partitionEithers <$>
+    manyTill
+      (   ( Left  <$> try ignoreDefine)
+      <|> ( Right <$> enumeration enumNamesAndTypes)
+      <|> ( Left  <$> ignoreStruct)
+      )
+      ( namedSection "Callbacks" )
+
+  _ <- skipManyTill anySingle ( namedSection "Contexts" )
+
+  _ <- skipManyTill anySingle ( namedSection "Begin/End Plot" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Begin/End Subplot" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Setup" )
+  
+  _ <- skipManyTill anySingle ( namedSection "SetNext" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Plot Items" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Plot Tools" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Plot Utils" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Legend Utils" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Drag and Drop" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Styling" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Colormaps" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Input Mapping" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Miscellaneous" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Demo" )
+  
+  _ <- skipManyTill anySingle ( namedSection "Obsolete API" )
+
+  let
+    enums :: [ Enumeration () ]
+    enums = basicEnums
+  pure ( Headers { enums } )
+
+ignoreStruct :: MonadParsec CustomParseError [Tok] m => m ()
+ignoreStruct = do
+    void $ many comment
+    keyword "struct"
+    _structName <- identifier
+    ignoreInsideBraces
+    reservedSymbol ';'
+
+ignoreInsideBraces :: MonadParsec CustomParseError [Tok] m => m ()
+ignoreInsideBraces = do
+    reservedSymbol '{'
+    go (1 :: Int)
+      where
+       go 0 = return ()
+       go n = void $ skipManyTill anySingle ((reservedSymbol '{' *> go (n+1)) <|> reservedSymbol '}' *> go (n-1)) -- collect 1 more } than found {
+
+--- COPY/PASTE FROM Parser.hs of dear-imgui-generator
+
+--------------------------------------------------------------------------------
+-- Parsing forward declarations.
+
+forwardDeclarations
+  :: MonadParsec CustomParseError [Tok] m
+  => m ( HashMap Text Comment, HashMap Text ( TH.Name, Comment ) )
+forwardDeclarations = do
+  _ <- many comment
+  structs <- many do
+    keyword "struct"
+    structName <- identifier
+    reservedSymbol ';'
+    doc <- comment
+    pure ( structName, doc )
+  _ <- many comment
+  enums <- many do
+    keyword "typedef"
+    ty <- cTypeName
+    enumName <- identifier
+    reservedSymbol ';'
+    doc <- commentText <$> comment
+    pure ( enumName, ( ty, CommentText <$> Text.drop 2 . snd $ Text.breakOn "//" doc ) )
+  -- Stopping after simple structs and enums for now.
+  pure ( HashMap.fromList structs, HashMap.fromList enums )
+
+cTypeName :: MonadParsec e [Tok] m => m TH.Name
+cTypeName = keyword "int" $> ''CInt
+
+--------------------------------------------------------------------------------
+-- Parsing enumerations.
+
+data EnumState = EnumState
+  { enumValues       :: HashMap Text Integer
+  , currEnumTag      :: Integer
+  , enumSize         :: Integer
+  , hasExplicitCount :: Bool
+  }
+
+enumeration :: MonadParsec CustomParseError [Tok] m => HashMap Text ( TH.Name, Comment ) -> m ( Enumeration () )
+enumeration enumNamesAndTypes = do
+  inlineDocs <- try do
+    inlineDocs <- many comment
+    keyword "enum"
+    pure inlineDocs
+  fullEnumName <- identifier
+  let
+    enumName :: Text
+    enumName = Text.dropWhileEnd ( == '_' ) fullEnumName
+    enumTypeName :: ()
+    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 } ) <-
+    ( `runStateT` EnumState { enumValues = mempty, currEnumTag = 0, enumSize = 0, hasExplicitCount = False } ) $
+      catMaybes
+          <$> many
+               (   some ignoredPatternContent $> Nothing
+               <|> enumerationPattern fullEnumName
+               )
+  reservedSymbol '}'
+  reservedSymbol  ';'
+  pure ( Enumeration { .. } )
+
+ignoredPatternContent :: MonadParsec e [Tok] m => m ()
+ignoredPatternContent = void ( try comment ) <|> cppConditional
+
+enumerationPattern
+  :: MonadParsec CustomParseError [ Tok ] m
+  => Text
+  -> StateT EnumState m ( Maybe ( Text, Integer, Comment ) )
+enumerationPattern enumName = do
+  mbPatNameVal <- patternNameAndValue enumName
+  _ <- optional $ reservedSymbol ','
+  comm <- fromMaybe ( CommentText "" ) <$> optional comment
+  pure $
+    case mbPatNameVal of
+      Nothing                    -> Nothing
+      Just ( patName, patValue ) -> Just ( patName, patValue, comm )
+
+patternNameAndValue
+  :: forall m
+  .  MonadParsec CustomParseError [ Tok ] m
+  => Text
+  -> StateT EnumState m ( Maybe ( Text, Integer ) )
+patternNameAndValue enumName =
+  try do
+      sz <- count
+      modify' ( \ ( EnumState {..} ) -> EnumState { enumSize = sz, hasExplicitCount = True, .. } )
+      pure Nothing
+  <|> do
+        pat@( _, val ) <- value
+        modify' ( \ ( EnumState {..} ) -> EnumState { enumSize = enumSize + 1, currEnumTag = val + 1, .. } )
+        pure ( Just pat )
+  where
+    count :: StateT EnumState m Integer
+    count = do
+      let idName = enumName <> "COUNT"
+      _ <- single ( Identifier idName )
+
+      mbVal <- optional do
+        _ <- reservedSymbol '='
+        EnumState{enumValues} <- get
+        integerExpression enumValues
+
+      countVal <- case mbVal of
+        Nothing -> currEnumTag <$> get
+        Just ct -> pure ct
+
+      modify' ( \ st -> st { enumValues = HashMap.insert idName countVal ( enumValues st ) } )
+      pure countVal
+
+    value :: StateT EnumState m ( Text, Integer )
+    value = do
+      name <- identifier
+      val <- patternRHS
+      modify' ( \ st -> st { enumValues = HashMap.insert name val ( enumValues st ) } )
+      pure ( name, val )
+    patternRHS :: StateT EnumState m Integer
+    patternRHS =
+      ( do
+        reservedSymbol '='
+        EnumState{enumValues} <- get
+        try disjunction <|> try (integerExpression enumValues)
+      )
+      <|> ( currEnumTag <$> get )
+
+    disjunction :: StateT EnumState m Integer
+    disjunction = do
+      initial <- identifier <* symbol "|"
+      ( rest :: [Text] ) <- identifier `sepBy1` symbol "|"
+      let summands = initial : rest
+      valsMap <- enumValues <$> get
+      let
+        res :: Either [ Text ] Integer
+        res = foldr
+          ( \ summand errsOrVal -> case HashMap.lookup summand valsMap of
+            Nothing -> case errsOrVal of { Right _  -> Left [ summand ]; Left errs -> Left ( summand : errs ) }
+            Just v  -> case errsOrVal of { Right v' -> Right ( v + v' ); Left errs -> Left errs }
+          )
+          ( Right 0 )
+          summands
+      case res of
+        Left problems -> customFailure ( Couldn'tLookupEnumValues { enumName, problems } )
+        Right v -> pure v
+
+--------------------------------------------------------------------------------
+-- Simple token parsers.
+
+comment :: MonadParsec e [ Tok ] m => m Comment
+comment = CommentText <$>
+  token ( \ case { Comment comm -> Just comm; _ -> Nothing } ) mempty
+    <?> "comment"
+
+keyword :: MonadParsec e [ Tok ] m => Text -> m ()
+keyword kw = token ( \ case { Keyword kw' | kw == kw' -> Just (); _ -> Nothing } ) mempty
+  <?> ( Text.unpack kw <> " (keyword)" )
+
+identifier :: MonadParsec e [ Tok ] m => m Text
+identifier = token ( \ case { Identifier i -> Just i; _ -> Nothing } ) mempty
+  <?> "identifier"
+
+{-
+prefixedIdentifier :: MonadParsec e [ Tok ] m => Text -> m Text
+prefixedIdentifier prefix =
+  token
+    ( \ case
+      { Identifier i -> Text.dropWhile ( == '_' ) <$> Text.stripPrefix prefix i
+      ; _ -> Nothing
+      }
+    ) mempty
+-}
+
+reservedSymbol :: MonadParsec e [ Tok ] m => Char -> m ()
+reservedSymbol s = token ( \ case { ReservedSymbol s' | s == s' -> Just (); _ -> Nothing } ) mempty
+  <?> ( [s] <> " (reserved symbol)" )
+
+symbol :: MonadParsec e [ Tok ] m => Text -> m ()
+symbol s = token ( \ case { Symbolic s' | s == s' -> Just (); _ -> Nothing } ) mempty
+  <?> ( Text.unpack s <> " (symbol)" )
+
+integerExpression :: MonadParsec e [ Tok ] m => HashMap Text Integer -> m Integer
+integerExpression enums = try integerPower <|> try integerAdd <|> try integerSub <|> integer
+  where
+    integerPower :: MonadParsec e [ Tok ] m => m Integer
+    integerPower = do
+      a <- integer
+      _ <- symbol "<<"
+      i <- integer
+      pure ( a `shiftL` fromIntegral i )
+
+    integerAdd :: MonadParsec e [ Tok ] m => m Integer
+    integerAdd = do
+      a <- integer
+      _ <- symbol "+"
+      i <- integer
+      pure ( a + i )
+
+    integerSub :: MonadParsec e [ Tok ] m => m Integer
+    integerSub = do
+      a <- integer
+      _ <- symbol "-"
+      i <- integer
+      pure ( a - i )
+
+    integer :: forall e m. MonadParsec e [ Tok ] m => m Integer
+    integer =
+      option id mkSign <*>
+        token
+          ( \case
+              Number i suff
+                | Just  _  <- toBoundedInteger @Int64 i
+                , Right i' <- floatingOrInteger @Float @Integer i
+                , not ( Text.any ( (== 'f' ) . toLower ) suff )
+                ->
+                Just i'
+
+              Identifier name ->
+                HashMap.lookup name enums
+
+              _ ->
+                Nothing
+          )
+          mempty
+        <?> "integer"
+      where
+        mkSign :: m ( Integer -> Integer )
+        mkSign = ( symbol "+" $> id ) <|> ( symbol "-" $> negate )
+
+section :: MonadParsec e [ Tok ] m => m [Text]
+section =
+  do
+    sectionText <- try do
+      separator
+      token
+        ( \ case
+          { Comment txt -> fmap ( Text.dropWhile isSpace )
+                         . Text.stripPrefix "[SECTION]"
+                         . Text.dropWhile isSpace
+                         $ txt
+          ; _ -> Nothing
+          }
+        ) mempty
+    rest <- endOfSectionHeader
+    pure ( sectionText : filter ( not . Text.all ( \ c -> c == '-' || isSpace c ) ) rest )
+  <?> "section"
+
+separator :: MonadParsec e [ Tok ] m => m ()
+separator = token
+  ( \ case
+    { Comment hyphens | Text.length hyphens > 10 && Text.all ( == '-') hyphens -> Just ()
+    ; _ -> Nothing
+    }
+  ) mempty
+  <?> "separator"
+
+endOfSectionHeader :: MonadParsec e [ Tok ] m => m [Text]
+endOfSectionHeader =  try ( (:) <$> ( commentText <$> comment ) <*> endOfSectionHeader )
+                  <|> ( separator $> [] )
+
+namedSection :: MonadParsec CustomParseError [ Tok ] m => Text -> m ()
+namedSection sectionName =
+  do
+    sectionTexts <- section
+    case sectionTexts of
+      sectionText : _
+        | Just _ <- Text.stripPrefix sectionName sectionText
+        -> pure ()
+      _ -> customFailure ( UnexpectedSection { sectionName, problem = sectionTexts } )
+  <?> ( "section named " <> Text.unpack sectionName )
+
+cppDirective :: MonadParsec e [Tok] m => ( Text -> Maybe a ) -> m a
+cppDirective f = token ( \case { BeginCPP a -> f a; _ -> Nothing } ) mempty
+
+cppConditional :: MonadParsec e [Tok] m => m ()
+cppConditional = do
+  void $ cppDirective ( \case { "ifdef" -> Just True; "ifndef" -> Just False; _ -> Nothing } )
+  -- assumes no nesting
+  void $ skipManyTill anySingle ( cppDirective ( \case { "endif" -> Just (); _ -> Nothing } ) )
+  void $ skipManyTill anySingle ( single EndCPPLine )
+
+ignoreDefine :: MonadParsec e [Tok] m => m ()
+ignoreDefine = do
+  void $ many comment
+  void $ cppDirective ( \case { "define" -> Just (); _ -> Nothing } )
+  void $ skipManyTill anySingle ( single EndCPPLine )

src/DearImGui/Plot/Structs.hs

@@ -15,107 +15,6 @@ import Data.Word
 import Foreign
   ( Storable(..), castPtr, plusPtr )
 
---------------------------------------------------------------------------------
-data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }
-  deriving (Show)
-
-
-instance Storable ImVec2 where
-  sizeOf ~ImVec2{x, y} = sizeOf x + sizeOf y
-
-  alignment _ = 0
-
-  poke ptr ImVec2{ x, y } = do
-    poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
-    poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
-
-  peek ptr = do
-    x <- peek (castPtr ptr                         )
-    y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
-    return ImVec2{ x, y  }
-
-
-data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
-  deriving (Show)
-
-
-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 }
-  deriving (Show)
-
-
-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 }
-
---------------------------------------------------------------------------------
-
--- | DearImGui context handle.
-data ImGuiContext
-
--- | Individual font handle.
-data ImFont
-
--- | Font configuration handle.
-data ImFontConfig
-
--- | Glyph ranges builder handle.
-data ImFontGlyphRangesBuilder
-
--- | Opaque DrawList handle.
-data ImDrawList
-
--- | 'DearImGui.Raw.ListClipper.ListClipper' pointer tag.
-data ImGuiListClipper
-
--- | A unique ID used by widgets (typically the result of hashing a stack of string)
---   unsigned Integer (same as ImU32)
-type ImGuiID = Word32
-
--- | 32-bit unsigned integer (often used to store packed colors).
-type ImU32 = Word32
-
-type ImS16 = Int16
-
--- | Single wide character (used mostly in glyph management)
-#ifdef IMGUI_USE_WCHAR32
-type ImWchar = Word32
-#else
-type ImWchar = Word16
-#endif
-
---------------------------------------------------------------------------------
-
 -- | DearImPlot context handle
 data ImPlotContext
 

src/DearImGui/Raw/Plot.hs

@@ -27,7 +27,7 @@ module DearImGui.Raw.Plot
   , endPlot
 
   , plotLine
-  , setNextPlotLimits
+  -- , setNextPlotLimits
   ) where
 
 -- base
@@ -39,10 +39,12 @@ import System.IO.Unsafe
   ( unsafePerformIO )
 
 -- dear-imgui
+import DearImGui
 import DearImGui.Context
-  ( imguiContext, implotContext )
-import DearImGui.Enums
-import DearImGui.Structs
+import DearImGui.Plot.Context
+  ( implotContext )
+import DearImGui.Plot.Enums
+import DearImGui.Plot.Structs
 import DearImGui.Raw.DrawList (DrawList(..))
 
 -- inline-c
@@ -97,10 +99,10 @@ endPlot :: MonadIO m => m ()
 endPlot = liftIO do
   [C.exp| void { EndPlot(); } |]
 
-plotLine :: MonadIO m => CString -> Ptr Float -> Ptr Float -> CInt -> m ()
+plotLine :: MonadIO m => CString -> Ptr CFloat -> Ptr CFloat -> CInt -> m ()
 plotLine label xsPtr ysPtr size = liftIO do
-   [C.exp| void { PlotLine( $(char* descPtr), $(float *xsPtr), $(float *ysPtr), $(int size) ) } |]
+   [C.exp| void { PlotLine( $(char* label), $(float *xsPtr), $(float *ysPtr), $(int size) ) } |]
 
-setNextPlotLimits :: MonadIO m => (Double, Double) -> (Double, Double) -> m ()
-setNextPlotLimits (minX, maxX) (minY, maxY) = liftIO do
-  [C.exp| void { SetNextPlotLimits( $(double minX), $(double maxX), $(double minY), $(double maxY) ) } |]
+-- setNextPlotLimits :: MonadIO m => (CDouble, CDouble) -> (CDouble, CDouble) -> m ()
+-- setNextPlotLimits (minX, maxX) (minY, maxY) = liftIO do
+--   [C.exp| void { SetNextPlotLimits( $(double minX), $(double maxX), $(double minY), $(double maxY) ) } |]

src/DearImGui/Structs.hs

@@ -0,0 +1 @@
+../../dear-imgui.hs/src/DearImGui/Structs.hs