|
|
|
@ -1,53 +1,62 @@ |
|
|
|
{-# LANGUAGE TemplateHaskell #-} |
|
|
|
{-# LANGUAGE TemplateHaskell #-} |
|
|
|
module Main where |
|
|
|
module Main where |
|
|
|
|
|
|
|
|
|
|
|
import Brick.AttrMap |
|
|
|
import Brick.AttrMap |
|
|
|
import Brick.BChan |
|
|
|
import Brick.BChan |
|
|
|
import Brick.Main |
|
|
|
import Brick.Main |
|
|
|
import Brick.Types |
|
|
|
import Brick.Types |
|
|
|
import Brick.Widgets.Border |
|
|
|
import Brick.Widgets.Border |
|
|
|
import Brick.Widgets.Core |
|
|
|
import Brick.Widgets.Core |
|
|
|
import Control.Concurrent |
|
|
|
import Colog |
|
|
|
import qualified Control.Concurrent.BoundedChan as BC |
|
|
|
import Control.Concurrent |
|
|
|
import Control.Exception |
|
|
|
import Control.Concurrent.BoundedChan qualified as BC |
|
|
|
import Control.Monad |
|
|
|
import Control.Exception |
|
|
|
import Data.Aeson |
|
|
|
import Control.Monad |
|
|
|
import qualified Data.ByteString.Lazy as B |
|
|
|
import Data.Aeson |
|
|
|
import Data.IORef |
|
|
|
import Data.ByteString.Lazy qualified as B |
|
|
|
import qualified Data.List as L |
|
|
|
import Data.IORef |
|
|
|
import qualified Data.Map.Strict as M |
|
|
|
import Data.List qualified as L |
|
|
|
import qualified Graphics.Vty as Vty |
|
|
|
import Data.Map.Strict qualified as M |
|
|
|
import Lens.Micro.Platform |
|
|
|
import Graphics.Vty qualified as Vty |
|
|
|
import Lens.Micro.TH |
|
|
|
import Lens.Micro.Platform |
|
|
|
import System.ZMQ4 |
|
|
|
import Lens.Micro.TH |
|
|
|
|
|
|
|
import System.ZMQ4 |
|
|
|
|
|
|
|
|
|
|
|
import ATrade.QuoteSource.Client |
|
|
|
import ATrade.QuoteSource.Client |
|
|
|
import ATrade.Types |
|
|
|
import ATrade.Types |
|
|
|
|
|
|
|
|
|
|
|
import Config |
|
|
|
import Config |
|
|
|
import QuoteTable |
|
|
|
import QuoteTable |
|
|
|
|
|
|
|
|
|
|
|
data Name = Viewport1 |
|
|
|
data Name = Viewport1 deriving (Eq, Ord, Show) |
|
|
|
deriving (Show, Eq, Ord) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
data AppEvent = QuoteTableUpdate QuoteTable |
|
|
|
data AppEvent |
|
|
|
|
|
|
|
= QuoteTableUpdate QuoteTable |
|
|
|
|
|
|
|
|
|
|
|
data AppState = AppState { |
|
|
|
data AppState |
|
|
|
_quotes :: QuoteTable |
|
|
|
= AppState |
|
|
|
} |
|
|
|
{ _quotes :: QuoteTable |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
makeLenses ''AppState |
|
|
|
makeLenses ''AppState |
|
|
|
|
|
|
|
|
|
|
|
qsThread :: IORef QuoteTable -> AppConfig -> IO () |
|
|
|
qsThread :: IORef QuoteTable -> AppConfig -> IO () |
|
|
|
qsThread quotetable config = withContext $ \ctx -> do |
|
|
|
qsThread quotetable config = withContext $ \ctx -> do |
|
|
|
qschan <- BC.newBoundedChan 1000 |
|
|
|
qschan <- BC.newBoundedChan 1000 |
|
|
|
bracket (startQuoteSourceClient qschan (config ^. tickers) ctx (config ^. quoteSourceEndpoint) defaultClientSecurityParams) stopQuoteSourceClient $ \_ -> forever $ do |
|
|
|
bracket (startQuoteSourceClient |
|
|
|
|
|
|
|
qschan |
|
|
|
|
|
|
|
(config ^. tickers) |
|
|
|
|
|
|
|
ctx |
|
|
|
|
|
|
|
(config ^. quoteSourceEndpoint) |
|
|
|
|
|
|
|
defaultClientSecurityParams |
|
|
|
|
|
|
|
emptyLogAction) stopQuoteSourceClient $ \_ -> forever $ do |
|
|
|
qsdata <- BC.readChan qschan |
|
|
|
qsdata <- BC.readChan qschan |
|
|
|
case qsdata of |
|
|
|
case qsdata of |
|
|
|
QDTick tick -> handleNewTick quotetable tick |
|
|
|
QDTick tick -> handleNewTick quotetable tick |
|
|
|
_ -> return () |
|
|
|
_ -> return () |
|
|
|
where |
|
|
|
where |
|
|
|
handleNewTick s t = atomicModifyIORef s $ \table -> (updateTable table t, ()) |
|
|
|
handleNewTick s t = atomicModifyIORef s $ \table -> (updateTable table t, ()) |
|
|
|
|
|
|
|
emptyLogAction = LogAction (\_ -> return ()) |
|
|
|
|
|
|
|
|
|
|
|
quoteTableWriterThread :: IORef QuoteTable -> BChan AppEvent -> IO () |
|
|
|
quoteTableWriterThread :: IORef QuoteTable -> BChan AppEvent -> IO () |
|
|
|
quoteTableWriterThread qtRef chan = forever $ do |
|
|
|
quoteTableWriterThread qtRef chan = forever $ do |
|
|
|
@ -75,7 +84,7 @@ main = do |
|
|
|
initialVty <- buildVty |
|
|
|
initialVty <- buildVty |
|
|
|
qsThreadId <- forkIO $ qsThread quoteTableRef config |
|
|
|
qsThreadId <- forkIO $ qsThread quoteTableRef config |
|
|
|
qtwThreadId <- forkIO $ quoteTableWriterThread quoteTableRef eventChan |
|
|
|
qtwThreadId <- forkIO $ quoteTableWriterThread quoteTableRef eventChan |
|
|
|
void $ customMain buildVty (Just eventChan) app (initialState M.empty) |
|
|
|
void $ customMain initialVty buildVty (Just eventChan) app (initialState M.empty) |
|
|
|
where |
|
|
|
where |
|
|
|
initialState ref = AppState ref |
|
|
|
initialState ref = AppState ref |
|
|
|
draw :: AppState -> [Widget Name] |
|
|
|
draw :: AppState -> [Widget Name] |
|
|
|
|
