ibhelper/app/Main.hs
2022-07-18 17:50:28 +02:00

106 lines
3.9 KiB
Haskell

{-# 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.Plot
import DearImGui.OpenGL3
import DearImGui.SDL
import DearImGui.SDL.OpenGL
import Run
import RIO.Process
import System.Directory
import Options.Applicative.Simple
import qualified Paths_ibhelper
import qualified Data.Text as T
import Prelude (putStrLn)
import AppFiller
import SDL
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
initializeAll
liftIO $ runManaged $ do
win <- do
let title = "IB-Helper"
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL
, windowInitialSize = V2 (settings ^. windowParams . windowWidth . to fromIntegral) (settings ^. windowParams . windowHeight . to fromIntegral)
, windowResizable = True
}
managed $ bracket (createWindow title config) destroyWindow
-- 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
-- Initialize ImGui's SDL2 backend
_ <- managed_ $ bracket_ (sdl2InitForOpenGL win glContext) sdl2Shutdown
-- 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