From aac6fb0e4d14cd792b31611aee0374719e7e7252 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Sun, 27 Aug 2023 14:19:01 +0700 Subject: [PATCH] fix warnings --- src/Main.hs | 1 - src/TXMLConnector.hs | 30 ++++------------ src/TXMLConnector/Internal.hs | 66 ++++++++++++++--------------------- src/Transaq.hs | 3 +- transaq-connector.cabal | 3 +- 5 files changed, 36 insertions(+), 67 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index e28d32c..62d9b62 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -29,7 +29,6 @@ import Data.Version (showVersion) import Debug.EventCounters (emitEvent, initEventCounters) import HistoryProviderServer (withHistoryProviderServer) -import Network.URI (parseURI) import Prelude hiding (log) import System.IO (Handle, IOMode (AppendMode), diff --git a/src/TXMLConnector.hs b/src/TXMLConnector.hs index de5aa54..4576d46 100644 --- a/src/TXMLConnector.hs +++ b/src/TXMLConnector.hs @@ -15,47 +15,31 @@ module TXMLConnector import ATrade.Broker.Backend (BrokerBackend (..), BrokerBackendNotification (..)) -import ATrade.Logging (Message, Severity (..), log, +import ATrade.Logging (Message, Severity (..), logWith) import ATrade.QuoteSource.Server (QuoteSourceServerData (..)) import ATrade.Types (Order, OrderId) import Colog (HasLog (getLogAction, setLogAction), LogAction (LogAction, unLogAction)) -import Config (SubscriptionConfig (SubscriptionConfig), - TransaqConnectorConfig (..), - transaqHost, transaqLogLevel, - transaqLogPath, transaqLogin, - transaqPassword, transaqPort) -import Control.Concurrent (ThreadId, forkIO, threadDelay) +import Config (TransaqConnectorConfig (..)) +import Control.Concurrent (ThreadId, forkIO) import Control.Concurrent.BoundedChan (BoundedChan) -import Control.Concurrent.STM (TVar, atomically, modifyTVar', +import Control.Concurrent.STM (TVar, atomically, newEmptyTMVar, newEmptyTMVarIO, - newTVarIO, orElse, putTMVar, - readTMVar, readTVar, - readTVarIO, takeTMVar, - tryPutTMVar, tryReadTMVar, + newTVarIO, putTMVar, takeTMVar, writeTVar) -import Control.Concurrent.STM.TBQueue (TBQueue, flushTBQueue, - newTBQueue, readTBQueue, - writeTBQueue) +import Control.Concurrent.STM.TBQueue (TBQueue, newTBQueue) import Control.Concurrent.STM.TMVar (TMVar) -import Control.Monad (forM_, forever, void, when) -import Control.Monad.Extra (whileM) +import Control.Monad (void) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Reader (ReaderT (runReaderT)) import Control.Monad.Reader.Class (MonadReader) import qualified Data.Bimap as BM import qualified Data.Map.Strict as M -import Data.Maybe (mapMaybe) import qualified Data.Text as T import Data.Time.Clock (UTCTime, getCurrentTime) -import qualified Deque.Strict as D import GHC.Exts (IsList (..)) 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 TickTable (newTickTable) import Transaq (TransaqResponse) diff --git a/src/TXMLConnector/Internal.hs b/src/TXMLConnector/Internal.hs index ac588b3..8dc59c7 100644 --- a/src/TXMLConnector/Internal.hs +++ b/src/TXMLConnector/Internal.hs @@ -16,24 +16,21 @@ module TXMLConnector.Internal ) where import ATrade.Logging (Message, Severity (..), log) -import Colog (HasLog, LogAction (LogAction)) +import Colog (HasLog, LogAction) import Config (SubscriptionConfig (SubscriptionConfig), TransaqConnectorConfig (..), transaqHost, transaqLogLevel, transaqLogPath, transaqLogin, transaqPassword, transaqPort) -import Control.Concurrent (ThreadId, forkIO, threadDelay) +import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.STM (TVar, atomically, modifyTVar', - newEmptyTMVar, newEmptyTMVarIO, - newTVarIO, orElse, putTMVar, - readTMVar, readTVar, - readTVarIO, takeTMVar, - tryPutTMVar, tryReadTMVar, - writeTVar) + orElse, putTMVar, readTMVar, + readTVar, readTVarIO, + takeTMVar, tryPutTMVar, + tryReadTMVar, writeTVar) import Control.Concurrent.STM.TBQueue (TBQueue, flushTBQueue, - newTBQueue, readTBQueue, - writeTBQueue) -import Control.Monad (forM_, forever, void, when) + readTBQueue, writeTBQueue) +import Control.Monad (forM_, void, when) import Control.Monad.Extra (whileM) import qualified Data.Bimap as BM import Data.Maybe (mapMaybe) @@ -43,8 +40,7 @@ import Text.XML.Light.Input (parseXML) import Text.XML.Light.Types (Content (Elem), Element (elName), QName (qName)) -import TickTable (TickTable, insertTick, - lookupTick, newTickTable) +import TickTable (TickTable, insertTick) import Transaq (AllTradesTrade (..), Candle (..), ClientData (..), CommandCancelOrder (..), @@ -68,7 +64,6 @@ import Transaq (AllTradesTrade (..), ResponseMarkets (ResponseMarkets), ResponseOrders (ResponseOrders), ResponseQuotations (ResponseQuotations), - ResponseQuotes (ResponseQuotes), ResponseResult (..), ResponseSecurities (ResponseSecurities), ResponseTrades (ResponseTrades), @@ -80,12 +75,11 @@ import Transaq (AllTradesTrade (..), TransaqResponseC (fromXml), UnfilledAction (..), kCandleKindId, kPeriod, state) -import TXML (LogLevel, MonadTXML, - freeCallback, initialize, - sendCommand, setCallback) +import TXML (MonadTXML, freeCallback, + initialize, sendCommand, + setCallback) -import ATrade.Broker.Backend (BrokerBackend (..), - BrokerBackendNotification (..)) +import ATrade.Broker.Backend (BrokerBackendNotification (..)) import ATrade.QuoteSource.Server (QuoteSourceServerData (..)) import ATrade.Types (Bar (..), BarTimeframe (unBarTimeframe), @@ -96,13 +90,11 @@ import ATrade.Types (Bar (..), TickerId, Trade (..), fromDouble, toDouble) import qualified ATrade.Types as AT -import Colog.Monad (WithLog) import Control.Applicative ((<|>)) import Control.Concurrent.BoundedChan (BoundedChan, writeChan) import Control.Concurrent.STM.TMVar (TMVar) import Control.Error (headMay) import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Reader (ReaderT (runReaderT)) import Control.Monad.Reader.Class (MonadReader, asks) import Data.Int (Int64) import qualified Data.Map.Strict as M @@ -111,7 +103,6 @@ import Data.Time.Clock (UTCTime, diffUTCTime, import FSM (FSMCallback (..), FSMState (isTerminalState), makeFsm, runFsm) -import GHC.Exts (IsList (..)) import Prelude hiding (log) import TickerInfoServer (TickerInfo (..), TickerInfoServerHandle, @@ -286,7 +277,7 @@ handleTransaqData transaqData = do liftIO $ atomically $ do candles <- readTVar cur putTMVar tmvar $ ResponseHistory $ HistoryResponse - { hrBars = (candleToBar $ cSecurity respCandle) <$> (cCandles respCandle <> candles) + { hrBars = candleToBar (cSecurity respCandle) <$> (cCandles respCandle <> candles) , hrMoreData = False } _ -> log Warning "TXMLConnector.WorkThread" "Incoming candles without response var" @@ -325,7 +316,7 @@ handleTransaqData transaqData = do fromTransaqTrade transaqTrade order maybeTickerInfo = 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 Trade { @@ -436,7 +427,7 @@ handleConnected = do Left result -> do case headMay (parseXML result) >>= parseContent of Just (TransaqResponseResult (ResponseSuccess (Just transactionId))) -> do - brState <- asks brokerState + State <- asks brokerState respVar <- asks responseVar liftIO $ atomically $ do modifyTVar' (bsOrderMap brState) (M.insert (orderId order) order) @@ -473,29 +464,24 @@ handleConnected = do resp <- liftIO . atomically $ readTMVar respVar transactionMap <- liftIO $ readTVarIO (bsOrderTransactionIdMap brState) case BM.lookup oid transactionMap of - Just (TransactionId 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 - 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 + Just (TransactionId transactionId') -> sendCancelOrder transactionId' + Just (ExchangeOrderId eoid) -> sendCancelOrder eoid _ -> do log Debug "TXMLConnector.WorkThread" $ "Unable to locate transaction ID for order: " <> (T.pack . show) oid liftIO . atomically $ putTMVar resp ResponseOrderCancelled pure Nothing - _ -> pure Nothing where 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 now <- liftIO getCurrentTime tsVar <- asks requestTimestamp diff --git a/src/Transaq.hs b/src/Transaq.hs index ad0c223..7744dcc 100644 --- a/src/Transaq.hs +++ b/src/Transaq.hs @@ -497,8 +497,7 @@ newtype ResponseClient = ResponseClient ClientData deriving (Show, Eq, Ord) instance TransaqResponseC ResponseClient where - fromXml root = do - if (qName . elName) root == "client" + fromXml root = if (qName . elName) root == "client" then do !cClientId <- T.pack <$> findAttr (uname "id") root !cType <- T.pack <$> childContent "type" root diff --git a/transaq-connector.cabal b/transaq-connector.cabal index 207caf7..ae12556 100644 --- a/transaq-connector.cabal +++ b/transaq-connector.cabal @@ -59,6 +59,7 @@ executable transaq-connector , network-uri , ekg-statsd , ekg-core + , slave-thread extra-lib-dirs: lib ghc-options: -Wall -Wcompat @@ -95,7 +96,7 @@ test-suite transaq-connector-test , tasty-hunit , dhall , eventcounters - , libatrade == 0.14.0.0 + , libatrade == 0.15.0.0 , text , transformers , co-log