You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
96 lines
3.4 KiB
96 lines
3.4 KiB
6 years ago
|
{-# LANGUAGE TemplateHaskell #-}
|
||
|
|
module Main where
|
||
|
|
|
||
|
|
import Brick.AttrMap
|
||
|
|
import Brick.BChan
|
||
|
|
import Brick.Main
|
||
|
|
import Brick.Types
|
||
|
|
import Brick.Widgets.Border
|
||
|
|
import Brick.Widgets.Core
|
||
|
|
import Control.Concurrent
|
||
|
|
import qualified Control.Concurrent.BoundedChan as BC
|
||
|
|
import Control.Exception
|
||
|
|
import Control.Monad
|
||
|
|
import Data.Aeson
|
||
|
|
import qualified Data.ByteString.Lazy as B
|
||
|
|
import qualified Data.Map.Strict as M
|
||
|
|
import qualified Graphics.Vty as Vty
|
||
|
|
import Lens.Micro.Platform
|
||
|
|
import Lens.Micro.TH
|
||
|
|
import System.ZMQ4
|
||
|
|
|
||
|
|
import ATrade.QuoteSource.Client
|
||
|
|
import ATrade.Types
|
||
|
|
|
||
|
|
import Config
|
||
|
|
import QuoteTable
|
||
|
|
|
||
|
|
data Name = Viewport1
|
||
|
|
deriving (Show, Eq, Ord)
|
||
|
|
|
||
|
|
data AppEvent = IncomingTick Tick
|
||
|
|
|
||
|
|
data AppState = AppState {
|
||
|
|
_quotes :: QuoteTable
|
||
|
|
} deriving (Show, Eq)
|
||
|
|
|
||
|
|
makeLenses ''AppState
|
||
|
|
|
||
|
|
qsThread :: BChan AppEvent -> AppConfig -> IO ()
|
||
|
|
qsThread eventChan config = withContext $ \ctx -> do
|
||
|
|
qschan <- BC.newBoundedChan 1000
|
||
|
|
bracket (startQuoteSourceClient qschan (config ^. tickers) ctx (config ^. quoteSourceEndpoint) defaultClientSecurityParams) stopQuoteSourceClient $ \_ -> forever $ do
|
||
|
|
qsdata <- BC.readChan qschan
|
||
|
|
case qsdata of
|
||
|
|
QDTick tick -> writeBChan eventChan (IncomingTick tick)
|
||
|
|
_ -> return ()
|
||
|
|
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
maybeConfig <- decode' <$> B.readFile "atrade-brick.config"
|
||
|
|
case maybeConfig of
|
||
|
|
Nothing -> error "Can't parse config"
|
||
|
|
Just config -> do
|
||
|
|
let app = App {
|
||
|
|
appDraw = draw,
|
||
|
|
appChooseCursor = chooseCursor,
|
||
|
|
appHandleEvent = handleEvent,
|
||
|
|
appStartEvent = startEvent,
|
||
|
|
appAttrMap = attrMap'
|
||
|
|
}
|
||
|
|
eventChan <- Brick.BChan.newBChan 10
|
||
|
|
let buildVty = Vty.mkVty Vty.defaultConfig
|
||
|
|
initialVty <- buildVty
|
||
|
|
qsThreadId <- forkIO $ qsThread eventChan config
|
||
|
|
void $ customMain buildVty (Just eventChan) app initialState
|
||
|
|
where
|
||
|
|
initialState = AppState M.empty
|
||
|
|
draw :: AppState -> [Widget Name]
|
||
|
|
draw s = [hBox [vBox (txt <$> tickers s),
|
||
|
|
vBorder,
|
||
|
|
vBox (str <$> fmap (printEntry s qteLastPrice) (tickers s)),
|
||
|
|
vBorder,
|
||
|
|
vBox (str <$> fmap (printEntry s qteBid) (tickers s)),
|
||
|
|
vBorder,
|
||
|
|
vBox (str <$> fmap (printEntry s qteAsk) (tickers s))] ]
|
||
|
|
printEntry s l tickerId = case s ^. quotes . at tickerId of
|
||
|
|
Just qte -> show $ qte ^. l
|
||
|
|
Nothing -> "-"
|
||
|
|
tickers s = M.keys (s ^. quotes)
|
||
|
|
chooseCursor s loc = Nothing
|
||
|
|
handleEvent s event = case event of
|
||
|
|
VtyEvent e -> case e of
|
||
|
|
Vty.EvKey (Vty.KChar 'q') [] -> halt s
|
||
|
|
_ -> continue s
|
||
|
|
AppEvent e -> case e of
|
||
|
|
IncomingTick t -> continue $ handleNewTick s t
|
||
|
|
_ -> continue s
|
||
|
|
startEvent = return
|
||
|
|
attrMap' s = attrMap Vty.defAttr []
|
||
|
|
handleNewTick s t = case datatype t of
|
||
|
|
LastTradePrice -> s & quotes . at (security t) . non emptyQuoteTableEntry . qteLastPrice .~ value t
|
||
|
|
BestBid -> s & quotes . at (security t) . non emptyQuoteTableEntry . qteBid .~ value t
|
||
|
|
BestOffer -> s & quotes . at (security t) . non emptyQuoteTableEntry . qteAsk .~ value t
|
||
|
|
_ -> s
|