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

fix warnings

master
Denis Tereshkin 2 years ago
parent
631066fb00
commit
aac6fb0e4d
5 changed files with 36 additions and 67 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. 1
      src/Main.hs
  2. 30
      src/TXMLConnector.hs
  3. 66
      src/TXMLConnector/Internal.hs
  4. 3
      src/Transaq.hs
  5. 3
      transaq-connector.cabal

1
src/Main.hs
Unescape View File

@ -29,7 +29,6 @@ import Data.Version (showVersion)
import Debug.EventCounters (emitEvent, import Debug.EventCounters (emitEvent,
initEventCounters) initEventCounters)
import HistoryProviderServer (withHistoryProviderServer) import HistoryProviderServer (withHistoryProviderServer)
import Network.URI (parseURI)
import Prelude hiding (log) import Prelude hiding (log)
import System.IO (Handle, import System.IO (Handle,
IOMode (AppendMode), IOMode (AppendMode),

30
src/TXMLConnector.hs
Unescape View File

@ -15,47 +15,31 @@ module TXMLConnector
import ATrade.Broker.Backend (BrokerBackend (..), import ATrade.Broker.Backend (BrokerBackend (..),
BrokerBackendNotification (..)) BrokerBackendNotification (..))
import ATrade.Logging (Message, Severity (..), log, import ATrade.Logging (Message, Severity (..),
logWith) logWith)
import ATrade.QuoteSource.Server (QuoteSourceServerData (..)) import ATrade.QuoteSource.Server (QuoteSourceServerData (..))
import ATrade.Types (Order, OrderId) import ATrade.Types (Order, OrderId)
import Colog (HasLog (getLogAction, setLogAction), import Colog (HasLog (getLogAction, setLogAction),
LogAction (LogAction, unLogAction)) LogAction (LogAction, unLogAction))
import Config (SubscriptionConfig (SubscriptionConfig), import Config (TransaqConnectorConfig (..))
TransaqConnectorConfig (..), import Control.Concurrent (ThreadId, forkIO)
transaqHost, transaqLogLevel,
transaqLogPath, transaqLogin,
transaqPassword, transaqPort)
import Control.Concurrent (ThreadId, forkIO, threadDelay)
import Control.Concurrent.BoundedChan (BoundedChan) import Control.Concurrent.BoundedChan (BoundedChan)
import Control.Concurrent.STM (TVar, atomically, modifyTVar', import Control.Concurrent.STM (TVar, atomically,
newEmptyTMVar, newEmptyTMVarIO, newEmptyTMVar, newEmptyTMVarIO,
newTVarIO, orElse, putTMVar, newTVarIO, putTMVar, takeTMVar,
readTMVar, readTVar,
readTVarIO, takeTMVar,
tryPutTMVar, tryReadTMVar,
writeTVar) writeTVar)
import Control.Concurrent.STM.TBQueue (TBQueue, flushTBQueue, import Control.Concurrent.STM.TBQueue (TBQueue, newTBQueue)
newTBQueue, readTBQueue,
writeTBQueue)
import Control.Concurrent.STM.TMVar (TMVar) import Control.Concurrent.STM.TMVar (TMVar)
import Control.Monad (forM_, forever, void, when) import Control.Monad (void)
import Control.Monad.Extra (whileM)
import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (ReaderT (runReaderT)) import Control.Monad.Reader (ReaderT (runReaderT))
import Control.Monad.Reader.Class (MonadReader) import Control.Monad.Reader.Class (MonadReader)
import qualified Data.Bimap as BM import qualified Data.Bimap as BM
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe (mapMaybe)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.Clock (UTCTime, getCurrentTime)
import qualified Deque.Strict as D
import GHC.Exts (IsList (..)) import GHC.Exts (IsList (..))
import Prelude hiding (log) import Prelude hiding (log)
import Text.XML.Light.Input (parseXML)
import Text.XML.Light.Types (Content (Elem),
Element (elName),
QName (qName))
import TickerInfoServer (TickerInfoServerHandle) import TickerInfoServer (TickerInfoServerHandle)
import TickTable (newTickTable) import TickTable (newTickTable)
import Transaq (TransaqResponse) import Transaq (TransaqResponse)

66
src/TXMLConnector/Internal.hs
Unescape View File

@ -16,24 +16,21 @@ module TXMLConnector.Internal
) where ) where
import ATrade.Logging (Message, Severity (..), log) import ATrade.Logging (Message, Severity (..), log)
import Colog (HasLog, LogAction (LogAction)) import Colog (HasLog, LogAction)
import Config (SubscriptionConfig (SubscriptionConfig), import Config (SubscriptionConfig (SubscriptionConfig),
TransaqConnectorConfig (..), TransaqConnectorConfig (..),
transaqHost, transaqLogLevel, transaqHost, transaqLogLevel,
transaqLogPath, transaqLogin, transaqLogPath, transaqLogin,
transaqPassword, transaqPort) transaqPassword, transaqPort)
import Control.Concurrent (ThreadId, forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (TVar, atomically, modifyTVar', import Control.Concurrent.STM (TVar, atomically, modifyTVar',
newEmptyTMVar, newEmptyTMVarIO, orElse, putTMVar, readTMVar,
newTVarIO, orElse, putTMVar, readTVar, readTVarIO,
readTMVar, readTVar, takeTMVar, tryPutTMVar,
readTVarIO, takeTMVar, tryReadTMVar, writeTVar)
tryPutTMVar, tryReadTMVar,
writeTVar)
import Control.Concurrent.STM.TBQueue (TBQueue, flushTBQueue, import Control.Concurrent.STM.TBQueue (TBQueue, flushTBQueue,
newTBQueue, readTBQueue, readTBQueue, writeTBQueue)
writeTBQueue) import Control.Monad (forM_, void, when)
import Control.Monad (forM_, forever, 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.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
@ -43,8 +40,7 @@ import Text.XML.Light.Input (parseXML)
import Text.XML.Light.Types (Content (Elem), import Text.XML.Light.Types (Content (Elem),
Element (elName), Element (elName),
QName (qName)) QName (qName))
import TickTable (TickTable, insertTick, import TickTable (TickTable, insertTick)
lookupTick, newTickTable)
import Transaq (AllTradesTrade (..), import Transaq (AllTradesTrade (..),
Candle (..), ClientData (..), Candle (..), ClientData (..),
CommandCancelOrder (..), CommandCancelOrder (..),
@ -68,7 +64,6 @@ import Transaq (AllTradesTrade (..),
ResponseMarkets (ResponseMarkets), ResponseMarkets (ResponseMarkets),
ResponseOrders (ResponseOrders), ResponseOrders (ResponseOrders),
ResponseQuotations (ResponseQuotations), ResponseQuotations (ResponseQuotations),
ResponseQuotes (ResponseQuotes),
ResponseResult (..), ResponseResult (..),
ResponseSecurities (ResponseSecurities), ResponseSecurities (ResponseSecurities),
ResponseTrades (ResponseTrades), ResponseTrades (ResponseTrades),
@ -80,12 +75,11 @@ import Transaq (AllTradesTrade (..),
TransaqResponseC (fromXml), TransaqResponseC (fromXml),
UnfilledAction (..), UnfilledAction (..),
kCandleKindId, kPeriod, state) kCandleKindId, kPeriod, state)
import TXML (LogLevel, MonadTXML, import TXML (MonadTXML, freeCallback,
freeCallback, initialize, initialize, sendCommand,
sendCommand, setCallback) setCallback)
import ATrade.Broker.Backend (BrokerBackend (..), import ATrade.Broker.Backend (BrokerBackendNotification (..))
BrokerBackendNotification (..))
import ATrade.QuoteSource.Server (QuoteSourceServerData (..)) import ATrade.QuoteSource.Server (QuoteSourceServerData (..))
import ATrade.Types (Bar (..), import ATrade.Types (Bar (..),
BarTimeframe (unBarTimeframe), BarTimeframe (unBarTimeframe),
@ -96,13 +90,11 @@ import ATrade.Types (Bar (..),
TickerId, Trade (..), TickerId, Trade (..),
fromDouble, toDouble) fromDouble, toDouble)
import qualified ATrade.Types as AT import qualified ATrade.Types as AT
import Colog.Monad (WithLog)
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.Error (headMay)
import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (ReaderT (runReaderT))
import Control.Monad.Reader.Class (MonadReader, asks) import Control.Monad.Reader.Class (MonadReader, asks)
import Data.Int (Int64) import Data.Int (Int64)
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
@ -111,7 +103,6 @@ import Data.Time.Clock (UTCTime, diffUTCTime,
import FSM (FSMCallback (..), import FSM (FSMCallback (..),
FSMState (isTerminalState), FSMState (isTerminalState),
makeFsm, runFsm) makeFsm, runFsm)
import GHC.Exts (IsList (..))
import Prelude hiding (log) import Prelude hiding (log)
import TickerInfoServer (TickerInfo (..), import TickerInfoServer (TickerInfo (..),
TickerInfoServerHandle, TickerInfoServerHandle,
@ -286,7 +277,7 @@ handleTransaqData transaqData = do
liftIO $ atomically $ do liftIO $ atomically $ do
candles <- readTVar cur candles <- readTVar cur
putTMVar tmvar $ ResponseHistory $ HistoryResponse putTMVar tmvar $ ResponseHistory $ HistoryResponse
{ hrBars = (candleToBar $ cSecurity respCandle) <$> (cCandles respCandle <> candles) { hrBars = candleToBar (cSecurity respCandle) <$> (cCandles respCandle <> candles)
, hrMoreData = False , hrMoreData = False
} }
_ -> log Warning "TXMLConnector.WorkThread" "Incoming candles without response var" _ -> log Warning "TXMLConnector.WorkThread" "Incoming candles without response var"
@ -325,7 +316,7 @@ handleTransaqData transaqData = do
fromTransaqTrade transaqTrade order maybeTickerInfo = fromTransaqTrade transaqTrade order maybeTickerInfo =
let vol = case maybeTickerInfo of let vol = case maybeTickerInfo of
Just tickerInfo -> (tPrice transaqTrade / tiTickSize tickerInfo * tiTickPrice tickerInfo) Just tickerInfo -> tPrice transaqTrade / tiTickSize tickerInfo * tiTickPrice tickerInfo
Nothing -> tPrice transaqTrade in Nothing -> tPrice transaqTrade in
Trade Trade
{ {
@ -436,7 +427,7 @@ handleConnected = do
Left result -> do Left result -> do
case headMay (parseXML result) >>= parseContent of case headMay (parseXML result) >>= parseContent of
Just (TransaqResponseResult (ResponseSuccess (Just transactionId))) -> do Just (TransaqResponseResult (ResponseSuccess (Just transactionId))) -> do
brState <- asks brokerState State <- asks brokerState
respVar <- asks responseVar respVar <- asks responseVar
liftIO $ atomically $ do liftIO $ atomically $ do
modifyTVar' (bsOrderMap brState) (M.insert (orderId order) order) modifyTVar' (bsOrderMap brState) (M.insert (orderId order) order)
@ -473,29 +464,24 @@ handleConnected = do
resp <- liftIO . atomically $ readTMVar respVar resp <- liftIO . atomically $ readTMVar respVar
transactionMap <- liftIO $ readTVarIO (bsOrderTransactionIdMap brState) transactionMap <- liftIO $ readTVarIO (bsOrderTransactionIdMap brState)
case BM.lookup oid transactionMap of case BM.lookup oid transactionMap of
Just (TransactionId transactionId) -> do Just (TransactionId transactionId') -> sendCancelOrder transactionId'
v <- sendCommand . toXml $ (CommandCancelOrder $ toInteger transactionId) Just (ExchangeOrderId eoid) -> sendCancelOrder eoid
case v of
Left result -> do
log Debug "TXMLConnector.WorkThread" $ "Cancellation result: " <> (T.pack . show) result
liftIO . atomically $ putTMVar resp ResponseOrderCancelled
_ -> liftIO . atomically $ putTMVar resp ResponseOrderCancelled
Just (ExchangeOrderId eoid) -> do
v <- sendCommand . toXml $ (CommandCancelOrder $ toInteger eoid)
case v of
Left result -> do
log Debug "TXMLConnector.WorkThread" $ "Cancellation result: " <> (T.pack . show) result
liftIO . atomically $ putTMVar resp ResponseOrderCancelled
_ -> liftIO . atomically $ putTMVar resp ResponseOrderCancelled
_ -> do _ -> do
log Debug "TXMLConnector.WorkThread" $ "Unable to locate transaction ID for order: " <> (T.pack . show) oid log Debug "TXMLConnector.WorkThread" $ "Unable to locate transaction ID for order: " <> (T.pack . show) oid
liftIO . atomically $ putTMVar resp ResponseOrderCancelled liftIO . atomically $ putTMVar resp ResponseOrderCancelled
pure Nothing pure Nothing
_ -> pure Nothing
where where
requestTimeoutValue = 10 requestTimeoutValue = 10
sendCancelOrder transactionId' = do
v <- sendCommand . toXml $ (CommandCancelOrder $ toInteger transactionId)
case v of
Left result -> do
log Debug "TXMLConnector.WorkThread" $ "Cancellation result: " <> (T.pack . show) result
liftIO . atomically $ putTMVar resp ResponseOrderCancelled
_ -> liftIO . atomically $ putTMVar resp ResponseOrderCancelled
checkRequestTimeout = do checkRequestTimeout = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
tsVar <- asks requestTimestamp tsVar <- asks requestTimestamp

3
src/Transaq.hs
Unescape View File

@ -497,8 +497,7 @@ newtype ResponseClient = ResponseClient ClientData
deriving (Show, Eq, Ord) deriving (Show, Eq, Ord)
instance TransaqResponseC ResponseClient where instance TransaqResponseC ResponseClient where
fromXml root = do fromXml root = if (qName . elName) root == "client"
if (qName . elName) root == "client"
then do then do
!cClientId <- T.pack <$> findAttr (uname "id") root !cClientId <- T.pack <$> findAttr (uname "id") root
!cType <- T.pack <$> childContent "type" root !cType <- T.pack <$> childContent "type" root

3
transaq-connector.cabal
Unescape View File

@ -59,6 +59,7 @@ executable transaq-connector
, network-uri , network-uri
, ekg-statsd , ekg-statsd
, ekg-core , ekg-core
, slave-thread
extra-lib-dirs: lib extra-lib-dirs: lib
ghc-options: -Wall ghc-options: -Wall
-Wcompat -Wcompat
@ -95,7 +96,7 @@ test-suite transaq-connector-test
, tasty-hunit , tasty-hunit
, dhall , dhall
, eventcounters , eventcounters
, libatrade == 0.14.0.0 , libatrade == 0.15.0.0
, text , text
, transformers , transformers
, co-log , co-log

Write Preview
Loading…
Cancel
Save