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
Split 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) @@ -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),

30
src/TXMLConnector.hs
Unescape View File

@ -15,47 +15,31 @@ module TXMLConnector @@ -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)

66
src/TXMLConnector/Internal.hs
Unescape View File

@ -16,24 +16,21 @@ module TXMLConnector.Internal @@ -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) @@ -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 (..), @@ -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 (..), @@ -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 (..), @@ -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, @@ -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 @@ -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 @@ -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 @@ -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 @@ -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

3
src/Transaq.hs
Unescape View File

@ -497,8 +497,7 @@ newtype ResponseClient = ResponseClient ClientData @@ -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

3
transaq-connector.cabal
Unescape View File

@ -59,6 +59,7 @@ executable transaq-connector @@ -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 @@ -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

Write Preview
Loading…
Cancel
Save