asakul
/
transaq-connector
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

TXMLConnector: minor refactoring and cleanup

master
Denis Tereshkin 2 years ago
parent
44442e0033
commit
69a88666f3
1 changed files with 20 additions and 18 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 38
      src/TXMLConnector/Internal.hs

38
src/TXMLConnector/Internal.hs
Unescape View File

@ -35,19 +35,16 @@ import Control.Exception
import Control.Monad (forM_, void, when) import Control.Monad (forM_, void, when)
import Control.Monad.Extra (whileM) import Control.Monad.Extra (whileM)
import qualified Data.Bimap as BM import qualified Data.Bimap as BM
import Data.Functor.Identity (Identity (..)) import Data.Maybe (catMaybes, fromMaybe)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import qualified Data.Text as T import qualified Data.Text as T
import Debug.EventCounters (emitEvent) import Debug.EventCounters (emitEvent)
import Debug.Trace
import qualified Deque.Strict as D import qualified Deque.Strict as D
import SlaveThread (fork) import SlaveThread (fork)
import System.IO import System.IO
import TickTable (TickTable, insertTick) import TickTable (TickTable, insertTick)
import Transaq (AllTradesTrade, import Transaq (AllTradesTrade,
AllTradesTradeB (..), Candle, AllTradesTradeB (..), Candle,
CandleB (..), ClientData, CandleB (..), ClientDataB (..),
ClientDataB (..),
CommandCancelOrder (..), CommandCancelOrder (..),
CommandChangePass (..), CommandChangePass (..),
CommandConnect (..), CommandConnect (..),
@ -57,14 +54,13 @@ import Transaq (AllTradesTrade,
CommandSubscribe (..), CommandSubscribe (..),
ConnectionState (Disconnected), ConnectionState (Disconnected),
Language (LanguageEn), Language (LanguageEn),
MarketInfo, MarketInfoB (..), MarketInfoB (..),
OrderNotification, OrderNotification,
OrderNotificationB (..), OrderNotificationB (..),
OrderStatus (..), Quotation, OrderStatus (..), Quotation,
QuotationB (..), QuotationB (..),
ResponseAllTrades (ResponseAllTrades), ResponseAllTrades (ResponseAllTrades),
ResponseCandleKinds (ResponseCandleKinds), ResponseCandleKinds (ResponseCandleKinds),
ResponseCandles,
ResponseCandlesB (..), ResponseCandlesB (..),
ResponseCandlesStatus (StatusPending), ResponseCandlesStatus (StatusPending),
ResponseClient (ResponseClient), ResponseClient (ResponseClient),
@ -81,7 +77,6 @@ import Transaq (AllTradesTrade,
TransaqCommand (toXml), TransaqCommand (toXml),
TransaqResponse (..), TransaqResponse (..),
TransaqResponse (..), TransaqResponse (..),
TransaqResponseC (fromXml),
UnfilledAction (..), UnfilledAction (..),
kCandleKindId, kPeriod, state) kCandleKindId, kPeriod, state)
import Transaq.Parsing (parseTransaqResponsesFromText) import Transaq.Parsing (parseTransaqResponsesFromText)
@ -105,7 +100,6 @@ import qualified ATrade.Types as AT
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Concurrent.BoundedChan (BoundedChan, writeChan) import Control.Concurrent.BoundedChan (BoundedChan, writeChan)
import Control.Concurrent.STM.TMVar (TMVar) import Control.Concurrent.STM.TMVar (TMVar)
import Control.Error (headMay)
import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader.Class (MonadReader, asks) import Control.Monad.Reader.Class (MonadReader, asks)
import Data.Int (Int64) import Data.Int (Int64)
@ -398,7 +392,16 @@ handleConnected = do
(takeTMVar timerVar' >> pure MainQueuePingServer) (takeTMVar timerVar' >> pure MainQueuePingServer)
case item of case item of
MainQueueShutdown -> pure $ Just StageShutdown MainQueueShutdown -> pure $ Just StageShutdown
MainQueuePingServer -> do MainQueuePingServer -> pingServer
MainQueueTransaqData transaqData -> handleTransaqData transaqData
MainQueueRequest (RequestHistory request) -> processHistoryRequest request
MainQueueRequest (RequestSubmitOrder order) -> processSubmitOrderRequest order
MainQueueRequest (RequestCancelOrder oid) -> processCancelOrderRequest oid
where
requestTimeoutValue = 10
pingServer = do
maybeServerStatus <- sendCommand $ toXml CommandServerStatus maybeServerStatus <- sendCommand $ toXml CommandServerStatus
case maybeServerStatus of case maybeServerStatus of
Left serverStatusRaw -> case parseTransaqResponsesFromText serverStatusRaw of Left serverStatusRaw -> case parseTransaqResponsesFromText serverStatusRaw of
@ -408,8 +411,8 @@ handleConnected = do
log Warning "TXMLConnector.WorkThread" $ "Unable to parser server status response: " <> (T.pack . show ) serverStatusRaw log Warning "TXMLConnector.WorkThread" $ "Unable to parser server status response: " <> (T.pack . show ) serverStatusRaw
pure Nothing pure Nothing
Right () -> pure Nothing Right () -> pure Nothing
MainQueueTransaqData transaqData -> handleTransaqData transaqData
MainQueueRequest (RequestHistory request) -> do processHistoryRequest request = do
cur <- asks currentCandles cur <- asks currentCandles
liftIO $ atomically $ writeTVar cur [] liftIO $ atomically $ writeTVar cur []
maybeCk <- M.lookup (unBarTimeframe . hrTimeframe $ request) <$> (asks candleKindMap >>= liftIO . readTVarIO) maybeCk <- M.lookup (unBarTimeframe . hrTimeframe $ request) <$> (asks candleKindMap >>= liftIO . readTVarIO)
@ -426,7 +429,8 @@ handleConnected = do
_ -> log Warning "TXMLConnector.WorkThread" $ "Unable to parse security ID: " <> hrTickerId request _ -> log Warning "TXMLConnector.WorkThread" $ "Unable to parse security ID: " <> hrTickerId request
_ -> log Warning "TXMLConnector.WorkThread" $ "Invalid candlekind requested" <> (T.pack . show . unBarTimeframe . hrTimeframe $ request) _ -> log Warning "TXMLConnector.WorkThread" $ "Invalid candlekind requested" <> (T.pack . show . unBarTimeframe . hrTimeframe $ request)
pure Nothing pure Nothing
MainQueueRequest (RequestSubmitOrder order) -> do
processSubmitOrderRequest order = do
log Debug "TXMLConnector.WorkThread" $ "Incoming request: submit order " <> (T.pack . show) order log Debug "TXMLConnector.WorkThread" $ "Incoming request: submit order " <> (T.pack . show) order
case mkNewOrderCommand order of case mkNewOrderCommand order of
Just cmd -> do Just cmd -> do
@ -465,7 +469,8 @@ handleConnected = do
log Warning "TXMLConnector.WorkThread" "Expected result, got nothing" log Warning "TXMLConnector.WorkThread" "Expected result, got nothing"
pure Nothing pure Nothing
_ -> pure Nothing _ -> pure Nothing
MainQueueRequest (RequestCancelOrder oid) -> do
processCancelOrderRequest oid = do
log Debug "TXMLConnector.WorkThread" $ "Incoming request: cancel order " <> (T.pack . show) oid log Debug "TXMLConnector.WorkThread" $ "Incoming request: cancel order " <> (T.pack . show) oid
brState <- asks brokerState brState <- asks brokerState
respVar <- asks responseVar respVar <- asks responseVar
@ -479,13 +484,10 @@ handleConnected = do
liftIO . atomically $ putTMVar resp ResponseOrderCancelled liftIO . atomically $ putTMVar resp ResponseOrderCancelled
pure Nothing pure Nothing
where
requestTimeoutValue = 10
sendCancelOrder transactionId' = do sendCancelOrder transactionId' = do
respVar <- asks responseVar respVar <- asks responseVar
resp <- liftIO . atomically $ readTMVar respVar resp <- liftIO . atomically $ readTMVar respVar
v <- sendCommand . toXml $ (CommandCancelOrder $ toInteger transactionId') v <- sendCommand . toXml $ CommandCancelOrder (toInteger transactionId')
case v of case v of
Left result -> do Left result -> do
log Debug "TXMLConnector.WorkThread" $ "Cancellation result: " <> (T.pack . show) result log Debug "TXMLConnector.WorkThread" $ "Cancellation result: " <> (T.pack . show) result

Write Preview
Loading…
Cancel
Save