Init

2022-03-14 20:12:24 +01:00
commit befb1ab1eb
23 changed files with 1973 additions and 0 deletions
--- a/app/Main.hs
+++ b/app/Main.hs
@ -0,0 +1,108 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Main (main) where
+
+import Import
+import Data.Aeson (eitherDecodeFileStrict')
+import Control.Monad.Managed
+import Control.Concurrent
+import DearImGui
+import DearImGui.OpenGL3
+import DearImGui.GLFW
+import DearImGui.GLFW.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
+
+
+main :: IO ()
+main = do
+  (options, ()) <- simpleOptions
+    $(simpleVersion Paths_ibhelper.version)
+    "Header for command line arguments"
+    "Program description, also for command line arguments"
+    (Options
+       <$> switch ( long "verbose"
+                 <> short 'v'
+                 <> help "Verbose output?"
+                  )
+    )
+    empty
+  settingsFileExists <- doesFileExist "settings.json"
+  settings <- if settingsFileExists
+              then do
+                s <- fmap unDefaultJSON <$> eitherDecodeFileStrict' "settings.json"
+                pPrint s
+                case s of
+                  Left e -> putStrLn ("Error loading settings: \n"<>e) >> return def
+                  Right s' -> return s'
+              else return def
+  lo <- logOptionsHandle stderr (optionsVerbose options)
+    <&> setLogMinLevel (settings ^. logLevel)
+    <&> setLogTerminal True
+  pc <- mkDefaultProcessContext
+  withLogFunc lo $ \lf -> do
+    -- let bare_log = unLogFunc $ view logFuncL lf
+    --     logErr = liftIO . bare_log callStack "" LevelError
+    initialized <- GLFW.init
+    unless initialized $ error "GLFW init failed"
+
+    liftIO $ runManaged $ do
+      mwin <- managed $ bracket
+        (GLFW.createWindow (settings ^. windowParams . windowWidth) (settings ^. windowParams . windowHeight) "IB-Helper" Nothing Nothing)
+        (maybe (return ()) GLFW.destroyWindow)
+      case mwin of
+        Just win -> do
+          liftIO $ do
+            GLFW.makeContextCurrent (Just win)
+            GLFW.swapInterval 1
+
+          -- Create an ImGui context
+          _ <- managed $ bracket createContext destroyContext
+
+          -- Create an ImPlot context
+          -- _ <- managed $ bracket createPlotContext destroyPlotContext
+
+          -- Initialize ImGui's GLFW backend
+          _ <- managed_ $ bracket_ (glfwInitForOpenGL win True) glfwShutdown
+
+          -- Initialize ImGui's OpenGL backend
+          _ <- managed_ $ bracket_ openGL3Init openGL3Shutdown
+
+          twsConnectionRefsHost <- liftIO $ atomically $ newTVar $ settings ^. twsConnection . host . to T.unpack
+          twsConnectionRefsPort <- liftIO $ atomically $ newTVar $ settings ^. twsConnection . port . to T.unpack
+          twsConnectionStatus   <- liftIO $ atomically $ newTVar $ TWSDisconnected
+          twsConnectionSend     <- liftIO $ atomically $ newTQueue
+          twsConnectionRecieve  <- liftIO $ atomically $ newTQueue
+          let twsConnectionRefs = TWSConnectionRefs{..}
+          liftIO $ atomically $ writeTQueue twsConnectionSend $ Msg_IB_OUT $ IB_RequestMarketDataType DelayedFrozen
+          currentAccount        <- liftIO $ newTVarIO $ Nothing
+          tickerIdToSymbol      <- liftIO $ newTVarIO $ mempty
+          appCharts <- liftIO $ newTVarIO $ mempty
+          appData <- liftIO $ DataRefs
+                          <$> newTVarIO mempty
+                          <*> newTVarIO Nothing
+                          <*> newTVarIO mempty
+                          <*> newTVarIO mempty
+          let app = App
+               { appSettings       = settings
+               , appLogFunc        = lf
+               , appProcessContext = pc
+               , appOptions        = options
+               , appWindow         = win
+               , appRefs           = AppRefs{..}
+               , appData           = appData
+               }
+          void $ liftIO $ forkIO $ appFiller app
+          liftIO $ runRIO app run
+        Nothing -> do
+          error "GLFW createWindow failed"
+
+  GLFW.terminate
+