ibhelper/app/Main.hs

{-# 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