109 lines
4.0 KiB
Haskell
109 lines
4.0 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.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
|
||
|
|
|