current state

.gitignore

@@ -6,3 +6,4 @@ imgui.ini
 settings.json
 *.lock
 tags
+dist-newstyle/

app/Main.hs

@@ -7,18 +7,19 @@ import Data.Aeson (eitherDecodeFileStrict')
 import Control.Monad.Managed
 import Control.Concurrent
 import DearImGui
+import DearImGui.Plot
 import DearImGui.OpenGL3
-import DearImGui.GLFW
+import DearImGui.SDL
-import DearImGui.GLFW.OpenGL
+import DearImGui.SDL.OpenGL
 import Run
 import RIO.Process
 import System.Directory
 import Options.Applicative.Simple
 import qualified Paths_ibhelper
-import qualified Graphics.UI.GLFW as GLFW
 import qualified Data.Text as T
 import Prelude (putStrLn)
 import AppFiller
+import SDL
 
 
 main :: IO ()
@@ -50,27 +51,28 @@ main = do
   withLogFunc lo $ \lf -> do
     -- let bare_log = unLogFunc $ view logFuncL lf
     --     logErr = liftIO . bare_log callStack "" LevelError
-    initialized <- GLFW.init
+    initializeAll
-    unless initialized $ error "GLFW init failed"
 
     liftIO $ runManaged $ do
-      mwin <- managed $ bracket
+      win <- do
-        (GLFW.createWindow (settings ^. windowParams . windowWidth) (settings ^. windowParams . windowHeight) "IB-Helper" Nothing Nothing)
+        let title = "IB-Helper"
-        (maybe (return ()) GLFW.destroyWindow)
+        let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL
-      case mwin of
+                                   , windowInitialSize = V2 (settings ^. windowParams . windowWidth . to fromIntegral) (settings ^. windowParams . windowHeight . to fromIntegral)
-        Just win -> do
+                                   , windowResizable = True
-          liftIO $ do
+                                   }
-            GLFW.makeContextCurrent (Just win)
+        managed $ bracket (createWindow title config) destroyWindow
-            GLFW.swapInterval 1
+
+      -- Create OpenGL Context
+      glContext <- managed $ bracket (glCreateContext win) glDeleteContext
 
       -- Create an ImGui context
       _ <- managed $ bracket createContext destroyContext
 
       -- Create an ImPlot context
-          -- _ <- managed $ bracket createPlotContext destroyPlotContext
+      _ <- managed $ bracket createPlotContext destroyPlotContext
 
-          -- Initialize ImGui's GLFW backend
+      -- Initialize ImGui's SDL2 backend
-          _ <- managed_ $ bracket_ (glfwInitForOpenGL win True) glfwShutdown
+      _ <- managed_ $ bracket_ (sdl2InitForOpenGL win glContext) sdl2Shutdown
 
       -- Initialize ImGui's OpenGL backend
       _ <- managed_ $ bracket_ openGL3Init openGL3Shutdown
@@ -101,8 +103,3 @@ main = do
            }
       void $ liftIO $ forkIO $ appFiller app
       liftIO $ runRIO app run
-        Nothing -> do
-          error "GLFW createWindow failed"
-
-  GLFW.terminate
-

cabal.project

@@ -0,0 +1,7 @@
+packages: deps/dear-imgui.hs
+          deps/dear-implot.hs
+          *.cabal
+package ibhelper
+  ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind
+shared: false
+static: true

deps/dear-imgui.hs

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

deps/dear-imgui.hs

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

deps/dear-implot.hs

@@ -1 +1 @@
-Subproject commit 78f7df091ceb88f57eaacdb0a1e2d43cbce04566
+Subproject commit 9a62697e8d50aae80536b6c4dbe6cef67062a71d

ibhelper.cabal

@@ -1,9 +1,10 @@
-cabal-version: 1.12
+-- This file has been generated from package.yaml by hpack version 0.27.0.
-
--- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
+--
+-- hash: db89b15a8762e7924ae32ea1dcce94b46e75d067b37cc058d3be20c1e0b98964
 
+cabal-version:  >= 1.10
 name:           ibhelper
 version:        0.1.0.0
 description:    Please see the README.md
@@ -15,9 +16,10 @@ copyright:      2022 Stefan Dresselhaus
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
+
 extra-source-files:
-    README.md
     ChangeLog.md
+    README.md
 
 source-repository head
   type: git
@@ -37,55 +39,22 @@ library
       Paths_ibhelper
   hs-source-dirs:
       src
-  default-extensions:
+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns DuplicateRecordFields
-      BangPatterns
-      BinaryLiterals
-      ConstraintKinds
-      DataKinds
-      DefaultSignatures
-      DeriveDataTypeable
-      DeriveFoldable
-      DeriveFunctor
-      DeriveGeneric
-      DeriveTraversable
-      DoAndIfThenElse
-      EmptyDataDecls
-      ExistentialQuantification
-      FlexibleContexts
-      FlexibleInstances
-      FunctionalDependencies
-      GADTs
-      GeneralizedNewtypeDeriving
-      InstanceSigs
-      KindSignatures
-      LambdaCase
-      MultiParamTypeClasses
-      MultiWayIf
-      NamedFieldPuns
-      NoImplicitPrelude
-      OverloadedStrings
-      PartialTypeSignatures
-      PatternGuards
-      PolyKinds
-      RankNTypes
-      RecordWildCards
-      ScopedTypeVariables
-      StandaloneDeriving
-      TupleSections
-      TypeFamilies
-      TypeSynonymInstances
-      ViewPatterns
-      DuplicateRecordFields
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
+  include-dirs:
+      deps/dear-implot.hs/implot
+      deps/dear-imgui.hs/imgui
+  extra-libraries:
+      HSdear-imgui-1.4.0-inplace
   build-depends:
-      GLFW-b
+      StateVar
-    , StateVar
     , aeson
     , base >=4.11 && <10
     , binary
     , bytestring
     , data-default
-    , dear-imgui
+    , dear-imgui >=1.4.0
+    , dear-implot
     , directory
     , fingertree
     , gl
@@ -94,6 +63,7 @@ library
     , network
     , pretty-show
     , rio >=0.1.12.0
+    , sdl2
     , stm
     , text
     , time
@@ -107,55 +77,22 @@ executable ibhelper-exe
       Paths_ibhelper
   hs-source-dirs:
       app
-  default-extensions:
+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns DuplicateRecordFields
-      BangPatterns
-      BinaryLiterals
-      ConstraintKinds
-      DataKinds
-      DefaultSignatures
-      DeriveDataTypeable
-      DeriveFoldable
-      DeriveFunctor
-      DeriveGeneric
-      DeriveTraversable
-      DoAndIfThenElse
-      EmptyDataDecls
-      ExistentialQuantification
-      FlexibleContexts
-      FlexibleInstances
-      FunctionalDependencies
-      GADTs
-      GeneralizedNewtypeDeriving
-      InstanceSigs
-      KindSignatures
-      LambdaCase
-      MultiParamTypeClasses
-      MultiWayIf
-      NamedFieldPuns
-      NoImplicitPrelude
-      OverloadedStrings
-      PartialTypeSignatures
-      PatternGuards
-      PolyKinds
-      RankNTypes
-      RecordWildCards
-      ScopedTypeVariables
-      StandaloneDeriving
-      TupleSections
-      TypeFamilies
-      TypeSynonymInstances
-      ViewPatterns
-      DuplicateRecordFields
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  include-dirs:
+      deps/dear-implot.hs/implot
+      deps/dear-imgui.hs/imgui
+  extra-libraries:
+      HSdear-imgui-1.4.0-inplace
   build-depends:
-      GLFW-b
+      StateVar
-    , StateVar
     , aeson
     , base >=4.11 && <10
     , binary
     , bytestring
     , data-default
-    , dear-imgui
+    , dear-imgui >=1.4.0
+    , dear-implot
     , directory
     , fingertree
     , gl
@@ -166,6 +103,7 @@ executable ibhelper-exe
     , optparse-simple
     , pretty-show
     , rio >=0.1.12.0
+    , sdl2
     , stm
     , text
     , time
@@ -181,55 +119,22 @@ test-suite ibhelper-test
       Paths_ibhelper
   hs-source-dirs:
       test
-  default-extensions:
+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns DuplicateRecordFields
-      BangPatterns
-      BinaryLiterals
-      ConstraintKinds
-      DataKinds
-      DefaultSignatures
-      DeriveDataTypeable
-      DeriveFoldable
-      DeriveFunctor
-      DeriveGeneric
-      DeriveTraversable
-      DoAndIfThenElse
-      EmptyDataDecls
-      ExistentialQuantification
-      FlexibleContexts
-      FlexibleInstances
-      FunctionalDependencies
-      GADTs
-      GeneralizedNewtypeDeriving
-      InstanceSigs
-      KindSignatures
-      LambdaCase
-      MultiParamTypeClasses
-      MultiWayIf
-      NamedFieldPuns
-      NoImplicitPrelude
-      OverloadedStrings
-      PartialTypeSignatures
-      PatternGuards
-      PolyKinds
-      RankNTypes
-      RecordWildCards
-      ScopedTypeVariables
-      StandaloneDeriving
-      TupleSections
-      TypeFamilies
-      TypeSynonymInstances
-      ViewPatterns
-      DuplicateRecordFields
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  include-dirs:
+      deps/dear-implot.hs/implot
+      deps/dear-imgui.hs/imgui
+  extra-libraries:
+      HSdear-imgui-1.4.0-inplace
   build-depends:
-      GLFW-b
+      StateVar
-    , StateVar
     , aeson
     , base >=4.11 && <10
     , binary
     , bytestring
     , data-default
-    , dear-imgui
+    , dear-imgui >=1.4.0
+    , dear-implot
     , directory
     , fingertree
     , gl
@@ -240,6 +145,7 @@ test-suite ibhelper-test
     , network
     , pretty-show
     , rio >=0.1.12.0
+    , sdl2
     , stm
     , text
     , time

package.yaml

@@ -19,6 +19,13 @@ extra-source-files:
 # common to point users to the README.md file.
 description:         Please see the README.md
 
+include-dirs:
+  - deps/dear-implot.hs/implot
+  - deps/dear-imgui.hs/imgui
+
+extra-libraries:
+  - HSdear-imgui-1.4.0-inplace
+
 default-extensions:
   - BangPatterns
   - BinaryLiterals
@@ -62,8 +69,7 @@ default-extensions:
 dependencies:
 - base >= 4.11 && < 10
 - rio >= 0.1.12.0
-- dear-imgui
+- dear-imgui >= 1.4.0
-- GLFW-b
 - managed
 - gl
 - aeson
@@ -81,6 +87,8 @@ dependencies:
 - time
 - unordered-containers
 - fingertree
+- dear-implot
+- sdl2
 
 ghc-options:
 - -Wall

src/Chart.hs

@@ -22,7 +22,7 @@ data FillerException = QuitFiller
 
 instance Exception FillerException
 
-deriving via Integer instance Hashable Day
+--deriving via Integer instance Hashable Day
 
 newChart :: IBContract -> RIO App ()
 newChart contract = do

src/Run.hs

@@ -11,11 +11,12 @@ import Data.Aeson (encodeFile)
 import Data.Bits
 import Data.FingerTree (ViewL(..), ViewR(..), viewl, viewr, split, FingerTree)
 import DearImGui
+import DearImGui.Plot
 import DearImGui.OpenGL3
-import DearImGui.GLFW
+import DearImGui.SDL
 import Graphics.GL
+import SDL
 import Data.StateVar
-import qualified Graphics.UI.GLFW as GLFW
 import qualified Data.Text as T
 import qualified Data.HashMap.Strict as HM
 import qualified Data.FingerTree as FT
@@ -30,22 +31,17 @@ run = do
 
   -- close connections to IB
 
-renderLoop :: RIO App ()
+shutdownApp :: RIO App ()
-renderLoop = do
+shutdownApp = do
   win <- appWindow <$> ask
-
-  liftIO GLFW.pollEvents
-  close <- liftIO $ GLFW.windowShouldClose win
-  if close
-  then do
   -- save settings & config
-    (w,h)    <- liftIO $ GLFW.getWindowSize win
+  (V2 w h) <- liftIO $ get $  windowSize win
   settings <- appSettings <$> ask
   refs     <- appRefs <$> ask
   host'    <- liftIO . readTVarIO . twsConnectionRefsHost . twsConnectionRefs $ refs
   port'    <- liftIO . readTVarIO . twsConnectionRefsPort . twsConnectionRefs $ refs
-    let settings' = settings & windowParams . windowWidth  .~ w
+  let settings' = settings & windowParams . windowWidth  .~ fromIntegral w
-                             & windowParams . windowHeight .~ h
+                           & windowParams . windowHeight .~ fromIntegral h
                            & twsConnection . host .~ T.pack host'
                            & twsConnection . port .~ T.pack port'
   liftIO $ encodeFile "settings.json" settings'
@@ -53,6 +49,24 @@ renderLoop = do
   -- save cached data
 
   logInfo $ display $ T.pack $ ppShow settings'
+
+renderLoop :: RIO App ()
+renderLoop = do
+  win <- appWindow <$> ask
+
+  let checkEvents = do
+        pollEventWithImGui >>= \case
+          Nothing ->
+            return False
+          Just event ->
+            (isQuit event ||) <$> checkEvents
+
+      isQuit event =
+        SDL.eventPayload event == SDL.QuitEvent
+
+  close <- liftIO checkEvents
+  if close
+  then shutdownApp
   else do
     refs' <- appRefs <$> ask
     data' <- appData <$> ask
@@ -61,7 +75,7 @@ renderLoop = do
     -- Tell ImGui we're starting a new frame
     liftIO $ do
       openGL3NewFrame
-      glfwNewFrame
+      sdl2NewFrame
       newFrame
 
 
@@ -70,7 +84,7 @@ renderLoop = do
       withMenuOpen "File" $ do
         menuItem "Quit" >>= \case
           False -> return ()
-          True  -> liftIO $ GLFW.setWindowShouldClose win True
+          True  -> shutdownApp
       let cr = twsConnectionRefs refs'
       accs <- fmap HM.keys $ liftIO $ readTVarIO $ Types.accounts data'
       withComboOpen "Account" (maybe "Select account" T.unpack selectedAccount) $ do
@@ -146,12 +160,12 @@ renderLoop = do
               forM_ ((accs HM.! aid) ^.. accountPortfolio . traverse) $ \(IBPortfolioValue c p mp mv ac up rp) -> 
                 do
                   tableNextRow
-                  whenM tableNextColumn (text $ T.unpack $ localSymbol c)
+                  tableNextColumn $ text $ T.unpack $ localSymbol c
-                  whenM tableNextColumn (text $ show p)
+                  tableNextColumn $ text $ show p
-                  whenM tableNextColumn (text $ show up)
+                  tableNextColumn $ text $ show up
-                  whenM tableNextColumn (text $ show rp)
+                  tableNextColumn $ text $ show rp
-                  whenM tableNextColumn (text $ show mp)
+                  tableNextColumn $ text $ show mp
-                  whenM tableNextColumn (text $ show mv)
+                  tableNextColumn $ text $ show mv
 
     bracket_ (begin "Search Symbols") end $ do
       readTVarIO (currentAccount refs') >>= \case
@@ -177,7 +191,7 @@ renderLoop = do
               tableSetupColumn "Primary exchange"
               tableSetupColumn "Currency"
               tableSetupColumn "Available derivatives"
-              withSortableTable $ \(mustSort, sortSpecs) -> do
+              withSortableTable $ \mustSort sortSpecs -> do
                 when mustSort $ liftIO $ pPrint sortSpecs
               tableHeadersRow
               lResult <- readTVarIO $ symbolLookupResults data'
@@ -190,9 +204,9 @@ renderLoop = do
                       True  -> do
                         logInfo $ display $ "new chart open for: " <> _symbol
                         newChart $ def { conId = _symbolId, symbol = _symbol, secType = _secType, exchange = "SMART", primaryExchange = _primaryExchange, currency = _currency}
-                let printDatum x = whenM tableNextColumn $ text $ T.unpack x
+                let printDatum x = tableNextColumn $ text $ T.unpack x
                 tableNextRow
-                whenM tableNextColumn $ do
+                tableNextColumn $ do
                   void $ selectableWith (defSelectableOptions { flags = ImGuiSelectableFlags_SpanAllColumns }) (T.unpack _symbol)
                   openPopupOnItemClick popupName ImGuiPopupFlags_MouseButtonRight
                 printDatum _secType
@@ -217,7 +231,7 @@ renderLoop = do
     showDemoWindow
 
     -- Show the ImPlot demo window
-    --showPlotDemoWindow
+    showPlotDemoWindow
 
     -- Render
     liftIO $ glClear GL_COLOR_BUFFER_BIT
@@ -225,6 +239,6 @@ renderLoop = do
     render
     liftIO $ openGL3RenderDrawData =<< getDrawData
 
-    liftIO $ GLFW.swapBuffers win
+    liftIO $ glSwapWindow win
 
     renderLoop

src/Types.hs

@@ -18,7 +18,7 @@ import Data.Time
 import Data.FingerTree
 import Data.Semigroup
 import GHC.Generics
-import Graphics.UI.GLFW (Window)
+import SDL (Window)
 import DearImGui
 import RIO
 import RIO.Process

stack.yaml

@@ -31,6 +31,7 @@ resolver: lts-18.24
 packages:
 - .
 - deps/dear-imgui.hs
+- deps/dear-implot.hs
 # Dependency packages to be pulled from upstream that are not in the resolver.
 # These entries can reference officially published versions as well as
 # forks / in-progress versions pinned to a git hash. For example:
@@ -50,8 +51,8 @@ allow-newer: true
 flags:
     dear-imgui:
       # libraries
-      glfw: true
+      glfw: false
-      sdl: false
+      sdl: true
       vulkan: false
       # hardware-requirements
       opengl3: true
@@ -73,7 +74,8 @@ flags:
 #
 # Extra directories used by stack for building
 # extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
+extra-lib-dirs:
+  - deps/dear-imgui.hs/build/
 #
 # Allow a newer minor version of GHC than the snapshot specifies
 # compiler-check: newer-minor