Fix warnings (#79)

This commit is contained in:
Alexander Bondarenko 2021-08-30 20:08:23 +03:00 committed by GitHub
parent 5699f64e95
commit f49e81c739
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 30 additions and 30 deletions

16
Main.hs
View File

@ -53,8 +53,8 @@ loop
-> IORef Bool -> IORef Bool
-> IORef Bool -> IORef Bool
-> IO () -> IO ()
loop w checked color slider r pos size' selected tab1Ref tab2Ref = do loop window checked color slider r pos size' selected tab1Ref tab2Ref = do
quit <- pollEvents shouldQuit <- checkEvents
openGL3NewFrame openGL3NewFrame
sdl2NewFrame sdl2NewFrame
@ -164,13 +164,15 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
glClear GL_COLOR_BUFFER_BIT glClear GL_COLOR_BUFFER_BIT
openGL3RenderDrawData =<< getDrawData openGL3RenderDrawData =<< getDrawData
glSwapWindow w glSwapWindow window
if quit then return () else loop w checked color slider r pos size' selected tab1Ref tab2Ref if shouldQuit
then return ()
else loop window checked color slider r pos size' selected tab1Ref tab2Ref
where where
pollEvents = do checkEvents = do
ev <- pollEventWithImGui ev <- pollEventWithImGui
case ev of case ev of
@ -180,9 +182,9 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
QuitEvent -> True QuitEvent -> True
_ -> False _ -> False
(isQuit ||) <$> pollEvents (isQuit ||) <$> checkEvents
whenTrue :: IO () -> Bool -> IO () whenTrue :: IO () -> Bool -> IO ()
whenTrue io True = io whenTrue io True = io
whenTrue io False = return () whenTrue _io False = return ()

View File

@ -1,3 +1,4 @@
packages: *.cabal packages: *.cabal
package dear-imgui package dear-imgui
flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan +examples flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan +examples
ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind

View File

@ -24,28 +24,28 @@ main = do
runManaged do runManaged do
-- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too. -- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
w <- do window <- do
let title = "Hello, Dear ImGui!" let title = "Hello, Dear ImGui!"
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL } let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
managed $ bracket (createWindow title config) destroyWindow managed $ bracket (createWindow title config) destroyWindow
-- Create an OpenGL context -- Create an OpenGL context
glContext <- managed $ bracket (glCreateContext w) glDeleteContext glContext <- managed $ bracket (glCreateContext window) glDeleteContext
-- Create an ImGui context -- Create an ImGui context
_ <- managed $ bracket createContext destroyContext _ <- managed $ bracket createContext destroyContext
-- Initialize ImGui's SDL2 backend -- Initialize ImGui's SDL2 backend
_ <- managed_ $ bracket_ (sdl2InitForOpenGL w glContext) sdl2Shutdown _ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
-- Initialize ImGui's OpenGL backend -- Initialize ImGui's OpenGL backend
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown _ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
liftIO $ mainLoop w liftIO $ mainLoop window
mainLoop :: Window -> IO () mainLoop :: Window -> IO ()
mainLoop w = do mainLoop window = do
-- Process the event loop -- Process the event loop
untilNothingM pollEventWithImGui untilNothingM pollEventWithImGui
@ -73,9 +73,9 @@ mainLoop w = do
render render
openGL2RenderDrawData =<< getDrawData openGL2RenderDrawData =<< getDrawData
glSwapWindow w glSwapWindow window
mainLoop w mainLoop window
where where
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m) untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)

View File

@ -12,8 +12,6 @@ module DearImGui.Generator
-- base -- base
import Control.Arrow import Control.Arrow
( second ) ( second )
import Data.Coerce
( coerce )
import Data.Bits import Data.Bits
( Bits ) ( Bits )
import Data.Foldable import Data.Foldable
@ -54,7 +52,6 @@ import qualified Language.Haskell.TH.Syntax as TH
-- text -- text
import qualified Data.Text as Text import qualified Data.Text as Text
( isInfixOf, null, unpack, unlines )
import qualified Data.Text.IO as Text import qualified Data.Text.IO as Text
( readFile ) ( readFile )
@ -161,7 +158,7 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
pure ( finiteEnumInst : ) pure ( finiteEnumInst : )
else pure id else pure id
synonyms <- for patterns \ ( patternName, patternValue, CommentText patDoc ) -> do synonyms <- for patterns \ ( patternName, patternValue, CommentText _patDoc ) -> do
let let
patNameStr :: String patNameStr :: String
patNameStr = Text.unpack patternName patNameStr = Text.unpack patternName
@ -169,7 +166,7 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
patSynSig <- TH.patSynSigD patName ( TH.conT tyName ) patSynSig <- TH.patSynSigD patName ( TH.conT tyName )
pat <- pat <-
#if MIN_VERSION_template_haskell(2,18,0) #if MIN_VERSION_template_haskell(2,18,0)
( if Text.null patDoc ( if Text.null _patDoc
then TH.patSynD then TH.patSynD
else else
\ nm args dir pat -> \ nm args dir pat ->