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

Transaq: strictness annotaions

master
Denis Tereshkin 3 years ago
parent
c59dc4cff2
commit
5d1a344b77
1 changed files with 285 additions and 284 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. 569
      src/Transaq.hs

569
src/Transaq.hs
Unescape View File

@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
@ -90,31 +91,31 @@ parseTimestamp = hush . parseOnly parser
where where
parser = parseWithDate <|> (UTCTime epoch <$> parseTime) parser = parseWithDate <|> (UTCTime epoch <$> parseTime)
parseWithDate = do parseWithDate = do
date <- parseDate !date <- parseDate
skipSpace skipSpace
time <- parseTime !time <- parseTime
pure $ UTCTime date time pure $ UTCTime date time
parseDate = do parseDate = do
day <- decimal !day <- decimal
void $ char '.' void $ char '.'
month <- decimal !month <- decimal
void $ char '.' void $ char '.'
year <- decimal !year <- decimal
pure $ fromGregorian year month day pure $ fromGregorian year month day
parseTime = do parseTime = do
hour <- (decimal :: Parser Int) !hour <- (decimal :: Parser Int)
void $ char ':' void $ char ':'
minute <- decimal !minute <- decimal
void $ char ':' void $ char ':'
second <- decimal !second <- decimal
msecs <- many' $ do msecs <- many' $ do
void $ char '.' void $ char '.'
(decimal :: Parser Int) (decimal :: Parser Int)
let secofday = hour * 3600 + minute * 60 + second let !secofday = hour * 3600 + minute * 60 + second
case msecs of case msecs of
[ms] -> pure $ fromIntegral secofday + fromIntegral ms / 1000.0 [!ms] -> pure $ fromIntegral secofday + fromIntegral ms / 1000.0
_ -> pure $ fromIntegral secofday _ -> pure $ fromIntegral secofday
epoch = fromGregorian 1970 1 1 epoch = fromGregorian 1970 1 1
@ -127,21 +128,21 @@ class TransaqResponseC t where
data CommandConnect = data CommandConnect =
CommandConnect CommandConnect
{ {
login :: T.Text, login :: !T.Text,
password :: T.Text, password :: !T.Text,
host :: T.Text, host :: !T.Text,
port :: Int, port :: !Int,
language :: Language, language :: !Language,
autopos :: Bool, autopos :: !Bool,
micexRegisters :: Bool, micexRegisters :: !Bool,
milliseconds :: Bool, milliseconds :: !Bool,
utcTime :: Bool, utcTime :: !Bool,
proxy :: (), -- not supported proxy :: (), -- not supported
rqDelay :: Maybe Int, rqDelay :: !(Maybe Int),
sessionTimeout :: Maybe Int, sessionTimeout :: !(Maybe Int),
requestTimeout :: Maybe Int, requestTimeout :: !(Maybe Int),
pushULimits :: Maybe Int, pushULimits :: !(Maybe Int),
pushPosEquity :: Maybe Int pushPosEquity :: !(Maybe Int)
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
instance Node CommandConnect where instance Node CommandConnect where
@ -177,8 +178,8 @@ instance TransaqCommand CommandDisconnect where
data SecurityId = data SecurityId =
SecurityId SecurityId
{ {
board :: T.Text board :: !T.Text
, seccode :: T.Text , seccode :: !T.Text
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
data CommandServerStatus = CommandServerStatus data CommandServerStatus = CommandServerStatus
@ -197,9 +198,9 @@ instance Node SecurityId where
data CommandSubscribe = data CommandSubscribe =
CommandSubscribe CommandSubscribe
{ {
alltrades :: [SecurityId] alltrades :: ![SecurityId]
, quotations :: [SecurityId] , quotations :: ![SecurityId]
, quotes :: [SecurityId] , quotes :: ![SecurityId]
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
instance TransaqCommand CommandSubscribe where instance TransaqCommand CommandSubscribe where
@ -213,9 +214,9 @@ instance TransaqCommand CommandSubscribe where
data CommandUnsubscribe = data CommandUnsubscribe =
CommandUnsubscribe CommandUnsubscribe
{ {
alltrades :: [SecurityId] alltrades :: ![SecurityId]
, quotations :: [SecurityId] , quotations :: ![SecurityId]
, quotes :: [SecurityId] , quotes :: ![SecurityId]
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
instance TransaqCommand CommandUnsubscribe where instance TransaqCommand CommandUnsubscribe where
@ -229,10 +230,10 @@ instance TransaqCommand CommandUnsubscribe where
data CommandGetHistoryData = data CommandGetHistoryData =
CommandGetHistoryData CommandGetHistoryData
{ {
security :: SecurityId security :: !SecurityId
, periodId :: Int , periodId :: !Int
, count :: Int , count :: !Int
, reset :: Bool , reset :: !Bool
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
instance TransaqCommand CommandGetHistoryData where instance TransaqCommand CommandGetHistoryData where
@ -265,17 +266,17 @@ instance Node UnfilledAction where
data CommandNewOrder = data CommandNewOrder =
CommandNewOrder CommandNewOrder
{ {
security :: SecurityId security :: !SecurityId
, client :: T.Text , client :: !T.Text
, unionCode :: T.Text , unionCode :: !T.Text
, price :: Double , price :: !Double
, quantity :: Int , quantity :: !Int
, buysell :: TradeDirection , buysell :: !TradeDirection
, bymarket :: Bool , bymarket :: !Bool
, brokerRef :: T.Text , brokerRef :: !T.Text
, unfilled :: UnfilledAction , unfilled :: !UnfilledAction
, usecredit :: Bool , usecredit :: !Bool
, nosplit :: Bool , nosplit :: !Bool
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
instance TransaqCommand CommandNewOrder where instance TransaqCommand CommandNewOrder where
@ -322,8 +323,8 @@ instance TransaqCommand CommandGetSecuritiesInfo where
data CommandChangePass = data CommandChangePass =
CommandChangePass CommandChangePass
{ {
cOldPass :: T.Text cOldPass :: !T.Text
, cNewPass :: T.Text , cNewPass :: !T.Text
} deriving (Show, Eq) } deriving (Show, Eq)
instance TransaqCommand CommandChangePass where instance TransaqCommand CommandChangePass where
@ -351,13 +352,13 @@ instance TransaqResponseC ResponseResult where
data Candle = data Candle =
Candle Candle
{ {
cTimestamp :: UTCTime cTimestamp :: !UTCTime
, cOpen :: Double , cOpen :: !Double
, cHigh :: Double , cHigh :: !Double
, cLow :: Double , cLow :: !Double
, cClose :: Double , cClose :: !Double
, cVolume :: Int , cVolume :: !Int
, cOpenInterest :: Int , cOpenInterest :: !Int
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
data ResponseCandlesStatus = data ResponseCandlesStatus =
@ -384,11 +385,11 @@ childContent tag el = strContent <$> findChild (uname tag) el
instance TransaqResponseC ResponseCandles where instance TransaqResponseC ResponseCandles where
fromXml root = do fromXml root = do
periodId <- findAttr (uname "period") root >>= readMaybe !periodId <- findAttr (uname "period") root >>= readMaybe
status <- findAttr (uname "status") root >>= readMaybe >>= parseStatus !status <- findAttr (uname "status") root >>= readMaybe >>= parseStatus
board <- T.pack <$> findAttr (uname "board") root !board <- T.pack <$> findAttr (uname "board") root
seccode <- T.pack <$> findAttr (uname "seccode") root !seccode <- T.pack <$> findAttr (uname "seccode") root
let candles = mapMaybe parseCandle . elChildren $ root let !candles = mapMaybe parseCandle . elChildren $ root
return ResponseCandles return ResponseCandles
{ {
cPeriodId = periodId cPeriodId = periodId
@ -406,13 +407,13 @@ instance TransaqResponseC ResponseCandles where
3 -> Just StatusUnavaliable 3 -> Just StatusUnavaliable
_ -> Nothing _ -> Nothing
parseCandle element = do parseCandle element = do
timestamp <- findAttr (uname "date") element >>= parseTimestamp . T.pack !timestamp <- findAttr (uname "date") element >>= parseTimestamp . T.pack
open <- findAttr (uname "open") element >>= readMaybe !open <- findAttr (uname "open") element >>= readMaybe
high <- findAttr (uname "high") element >>= readMaybe !high <- findAttr (uname "high") element >>= readMaybe
low <- findAttr (uname "low") element >>= readMaybe !low <- findAttr (uname "low") element >>= readMaybe
close <- findAttr (uname "close") element >>= readMaybe !close <- findAttr (uname "close") element >>= readMaybe
volume <- findAttr (uname "volume") element >>= readMaybe !volume <- findAttr (uname "volume") element >>= readMaybe
let openInterest = fromMaybe 0 $ findAttr (uname "oi") element >>= readMaybe let !openInterest = fromMaybe 0 $ findAttr (uname "oi") element >>= readMaybe
return Candle return Candle
{ {
cTimestamp = timestamp cTimestamp = timestamp
@ -433,36 +434,36 @@ data ConnectionState =
data ResponseServerStatus = data ResponseServerStatus =
ResponseServerStatus ResponseServerStatus
{ {
serverId :: Maybe Int serverId :: !(Maybe Int)
, state :: ConnectionState , state :: !ConnectionState
, recover :: Maybe Bool , recover :: !(Maybe Bool)
, serverTimezone :: Maybe T.Text , serverTimezone :: !(Maybe T.Text)
, systemVersion :: Maybe Int , systemVersion :: !(Maybe Int)
, build :: Maybe Int , build :: !(Maybe Int)
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
instance TransaqResponseC ResponseServerStatus where instance TransaqResponseC ResponseServerStatus where
fromXml root = do fromXml root = do
let serverId = findAttr (uname "id") root >>= readMaybe let !serverId = findAttr (uname "id") root >>= readMaybe
connectedStr <- findAttr (uname "connected") root !connectedStr <- findAttr (uname "connected") root
state <- case connectedStr of !state <- case connectedStr of
"true" -> pure Connected "true" -> pure Connected
"false" -> pure Disconnected "false" -> pure Disconnected
"error" -> pure $ Error (T.pack $ strContent root) "error" -> pure $ Error (T.pack $ strContent root)
_ -> pure Disconnected _ -> pure Disconnected
let recover = let !recover =
case findAttr (uname "recover") root of case findAttr (uname "recover") root of
Just "true" -> pure True Just "true" -> pure True
_ -> pure False _ -> pure False
let serverTimezone = T.pack <$> findAttr (uname "server_tz") root let !serverTimezone = T.pack <$> findAttr (uname "server_tz") root
let systemVersion = findAttr (uname "sys_ver") root >>= readMaybe let !systemVersion = findAttr (uname "sys_ver") root >>= readMaybe
let build = findAttr (uname "build") root >>= readMaybe let !build = findAttr (uname "build") root >>= readMaybe
pure $ ResponseServerStatus {..} pure $ ResponseServerStatus {..}
data MarketInfo = data MarketInfo =
MarketInfo MarketInfo
{ marketId :: Int { marketId :: !Int
, marketName :: T.Text , marketName :: !T.Text
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseMarkets = ResponseMarkets [MarketInfo] newtype ResponseMarkets = ResponseMarkets [MarketInfo]
@ -470,26 +471,26 @@ newtype ResponseMarkets = ResponseMarkets [MarketInfo]
instance TransaqResponseC ResponseMarkets where instance TransaqResponseC ResponseMarkets where
fromXml root = do fromXml root = do
markets <- mapM parseMarketInfo $ elChildren root !markets <- mapM parseMarketInfo $ elChildren root
pure . ResponseMarkets . catMaybes $ markets pure . ResponseMarkets . catMaybes $ markets
where where
parseMarketInfo tag = parseMarketInfo tag =
if (qName . elName) tag == "market" if (qName . elName) tag == "market"
then do then do
marketId <- findAttr (uname "id") tag >>= readMaybe !marketId <- findAttr (uname "id") tag >>= readMaybe
let marketName = T.pack $ strContent tag let !marketName = T.pack $ strContent tag
pure $ Just $ MarketInfo {..} pure $ Just $ MarketInfo {..}
else pure Nothing else pure Nothing
data ClientData = data ClientData =
ClientData ClientData
{ {
cClientId :: T.Text cClientId :: !T.Text
, cType :: T.Text , cType :: !T.Text
, cCurrency :: T.Text , cCurrency :: !T.Text
, cMarket :: T.Text , cMarket :: !T.Text
, cUnion :: T.Text , cUnion :: !T.Text
, cForts :: Maybe T.Text , cForts :: !(Maybe T.Text)
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseClient = ResponseClient ClientData newtype ResponseClient = ResponseClient ClientData
@ -499,21 +500,21 @@ instance TransaqResponseC ResponseClient where
fromXml root = do fromXml root = do
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
cCurrency <- T.pack <$> childContent "currency" root !cCurrency <- T.pack <$> childContent "currency" root
cMarket <- T.pack <$> childContent "market" root !cMarket <- T.pack <$> childContent "market" root
cUnion <- T.pack <$> childContent "union" root !cUnion <- T.pack <$> childContent "union" root
let cForts = T.pack <$> childContent "forts_acc" root let !cForts = T.pack <$> childContent "forts_acc" root
Just $ ResponseClient $ ClientData {..} Just $ ResponseClient $ ClientData {..}
else Nothing else Nothing
data CandleKind = data CandleKind =
CandleKind CandleKind
{ {
kCandleKindId :: Int kCandleKindId :: !Int
, kPeriod :: Int , kPeriod :: !Int
, kName :: T.Text , kName :: !T.Text
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseCandleKinds = ResponseCandleKinds [CandleKind] newtype ResponseCandleKinds = ResponseCandleKinds [CandleKind]
@ -522,35 +523,35 @@ newtype ResponseCandleKinds = ResponseCandleKinds [CandleKind]
instance TransaqResponseC ResponseCandleKinds where instance TransaqResponseC ResponseCandleKinds where
fromXml root = do fromXml root = do
kinds <- mapM parseCandleKind $ elChildren root !kinds <- mapM parseCandleKind $ elChildren root
pure . ResponseCandleKinds . catMaybes $ kinds pure . ResponseCandleKinds . catMaybes $ kinds
where where
parseCandleKind tag = parseCandleKind tag =
if (qName . elName) tag == "kind" if (qName . elName) tag == "kind"
then do then do
kCandleKindId <- childContent "id" tag >>= readMaybe !kCandleKindId <- childContent "id" tag >>= readMaybe
kPeriod <- childContent "period" tag >>= readMaybe !kPeriod <- childContent "period" tag >>= readMaybe
kName <- T.pack <$> childContent "name" tag !kName <- T.pack <$> childContent "name" tag
pure . Just $ CandleKind {..} pure . Just $ CandleKind {..}
else pure Nothing else pure Nothing
data Security = data Security =
Security Security
{ {
sSecId :: Int sSecId :: !Int
, sActive :: Bool , sActive :: !Bool
, sSeccode :: T.Text , sSeccode :: !T.Text
, sInstrClass :: T.Text , sInstrClass :: !T.Text
, sBoard :: T.Text , sBoard :: !T.Text
, sMarket :: T.Text , sMarket :: !T.Text
, sCurrency :: T.Text , sCurrency :: !T.Text
, sShortName :: T.Text , sShortName :: !T.Text
, sDecimals :: Int , sDecimals :: !Int
, sMinStep :: Double , sMinStep :: !Double
, sLotSize :: Int , sLotSize :: !Int
, sLotDivider :: Int , sLotDivider :: !Int
, sPointCost :: Double , sPointCost :: !Double
, sSecType :: T.Text , sSecType :: !T.Text
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseSecurities = newtype ResponseSecurities =
@ -565,20 +566,20 @@ instance TransaqResponseC ResponseSecurities where
parseSecurity tag = parseSecurity tag =
if (qName . elName) tag == "security" if (qName . elName) tag == "security"
then do then do
sSecId <- findAttr (uname "secid") tag >>= readMaybe !sSecId <- findAttr (uname "secid") tag >>= readMaybe
sActive <- findAttr (uname "active") tag >>= parseBool !sActive <- findAttr (uname "active") tag >>= parseBool
sSeccode <- T.pack <$> childContent "seccode" tag !sSeccode <- T.pack <$> childContent "seccode" tag
sInstrClass <- T.pack <$> childContent "instrclass" tag !sInstrClass <- T.pack <$> childContent "instrclass" tag
sBoard <- T.pack <$> childContent "board" tag !sBoard <- T.pack <$> childContent "board" tag
sMarket <- T.pack <$> childContent "market" tag !sMarket <- T.pack <$> childContent "market" tag
let sCurrency = fromMaybe "" $ T.pack <$> childContent "currency" tag let !sCurrency = fromMaybe "" $ T.pack <$> childContent "currency" tag
sShortName <- T.pack <$> childContent "shortname" tag !sShortName <- T.pack <$> childContent "shortname" tag
sDecimals <- childContent "decimals" tag >>= readMaybe !sDecimals <- childContent "decimals" tag >>= readMaybe
sMinStep <- childContent "minstep" tag >>= readMaybe !sMinStep <- childContent "minstep" tag >>= readMaybe
sLotSize <- childContent "lotsize" tag >>= readMaybe !sLotSize <- childContent "lotsize" tag >>= readMaybe
sLotDivider <- childContent "lotdivider" tag >>= readMaybe !sLotDivider <- childContent "lotdivider" tag >>= readMaybe
sPointCost <- childContent "point_cost" tag >>= readMaybe !sPointCost <- childContent "point_cost" tag >>= readMaybe
sSecType <- T.pack <$> childContent "sectype" tag !sSecType <- T.pack <$> childContent "sectype" tag
pure . Just $ Security {..} pure . Just $ Security {..}
else else
pure Nothing pure Nothing
@ -591,15 +592,15 @@ instance TransaqResponseC ResponseSecurities where
data ResponseSecInfo = data ResponseSecInfo =
ResponseSecInfo ResponseSecInfo
{ {
secId :: Int secId :: !Int
, secName :: T.Text , secName :: !T.Text
, secCode :: T.Text , secCode :: !T.Text
, market :: Int , market :: !Int
, pname :: T.Text , pname :: !T.Text
, clearingPrice :: Double , clearingPrice :: !Double
, minprice :: Double , minprice :: !Double
, maxprice :: Double , maxprice :: !Double
, pointCost :: Double , pointCost :: !Double
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
@ -619,26 +620,26 @@ instance TransaqResponseC ResponseSecInfo where
data Quotation = data Quotation =
Quotation Quotation
{ {
qSecId :: Int qSecId :: !Int
, qBoard :: T.Text , qBoard :: !T.Text
, qSeccode :: T.Text , qSeccode :: !T.Text
, qOpen :: Double , qOpen :: !Double
, qWaprice :: Double , qWaprice :: !Double
, qBidDepth :: Int , qBidDepth :: !Int
, qBidDepthT :: Int , qBidDepthT :: !Int
, qNumBids :: Int , qNumBids :: !Int
, qOfferDepth :: Int , qOfferDepth :: !Int
, qOfferDepthT :: Int , qOfferDepthT :: !Int
, qBid :: Double , qBid :: !Double
, qOffer :: Double , qOffer :: !Double
, qNumOffers :: Int , qNumOffers :: !Int
, qNumTrades :: Int , qNumTrades :: !Int
, qVolToday :: Int , qVolToday :: !Int
, qOpenPositions :: Int , qOpenPositions :: !Int
, qLastPrice :: Double , qLastPrice :: !Double
, qQuantity :: Int , qQuantity :: !Int
, qTimestamp :: UTCTime , qTimestamp :: !UTCTime
, qValToday :: Double , qValToday :: !Double
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseQuotations = newtype ResponseQuotations =
@ -651,26 +652,26 @@ instance TransaqResponseC ResponseQuotations where
pure . ResponseQuotations . catMaybes $ quotations pure . ResponseQuotations . catMaybes $ quotations
where where
parseQuotation tag = do parseQuotation tag = do
qSecId <- findAttr (uname "secid") tag >>= readMaybe !qSecId <- findAttr (uname "secid") tag >>= readMaybe
qBoard <- T.pack <$> childContent "board" tag !qBoard <- T.pack <$> childContent "board" tag
qSeccode <- T.pack <$> childContent "seccode" tag !qSeccode <- T.pack <$> childContent "seccode" tag
qOpen <- childContent "open" tag >>= readMaybe !qOpen <- childContent "open" tag >>= readMaybe
qWaprice <- childContent "waprice" tag >>= readMaybe !qWaprice <- childContent "waprice" tag >>= readMaybe
qBidDepth <- childContent "biddepth" tag >>= readMaybe !qBidDepth <- childContent "biddepth" tag >>= readMaybe
qBidDepthT <- childContent "biddeptht" tag >>= readMaybe !qBidDepthT <- childContent "biddeptht" tag >>= readMaybe
qNumBids <- childContent "numbids" tag >>= readMaybe !qNumBids <- childContent "numbids" tag >>= readMaybe
qBid <- childContent "bid" tag >>= readMaybe !qBid <- childContent "bid" tag >>= readMaybe
qOfferDepth <- childContent "offerdepth" tag >>= readMaybe !qOfferDepth <- childContent "offerdepth" tag >>= readMaybe
qOfferDepthT <- childContent "offerdeptht" tag >>= readMaybe !qOfferDepthT <- childContent "offerdeptht" tag >>= readMaybe
qNumOffers <- childContent "numoffers" tag >>= readMaybe !qNumOffers <- childContent "numoffers" tag >>= readMaybe
qOffer <- childContent "offer" tag >>= readMaybe !qOffer <- childContent "offer" tag >>= readMaybe
qNumTrades <- childContent "numtrades" tag >>= readMaybe !qNumTrades <- childContent "numtrades" tag >>= readMaybe
qVolToday <- childContent "voltoday" tag >>= readMaybe !qVolToday <- childContent "voltoday" tag >>= readMaybe
qOpenPositions <- childContent "openpositions" tag >>= readMaybe !qOpenPositions <- childContent "openpositions" tag >>= readMaybe
qLastPrice <- childContent "last" tag >>= readMaybe !qLastPrice <- childContent "last" tag >>= readMaybe
qQuantity <- childContent "quantity" tag >>= readMaybe !qQuantity <- childContent "quantity" tag >>= readMaybe
qTimestamp <- childContent "time" tag >>= (parseTimestamp . T.pack) !qTimestamp <- childContent "time" tag >>= (parseTimestamp . T.pack)
qValToday <- childContent "valToday" tag >>= readMaybe !qValToday <- childContent "valToday" tag >>= readMaybe
pure $ Just Quotation {..} pure $ Just Quotation {..}
data TradingPeriod = data TradingPeriod =
@ -683,16 +684,16 @@ data TradingPeriod =
data AllTradesTrade = data AllTradesTrade =
AllTradesTrade AllTradesTrade
{ {
attSecId :: Int attSecId :: !Int
, attSecCode :: T.Text , attSecCode :: !T.Text
, attTradeNo :: Int64 , attTradeNo :: !Int64
, attTimestamp :: UTCTime , attTimestamp :: !UTCTime
, attBoard :: T.Text , attBoard :: !T.Text
, attPrice :: Double , attPrice :: !Double
, attQuantity :: Int , attQuantity :: !Int
, attBuysell :: TradeDirection , attBuysell :: !TradeDirection
, attOpenInterest :: Int , attOpenInterest :: !Int
, attPeriod :: TradingPeriod , attPeriod :: !TradingPeriod
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseAllTrades = newtype ResponseAllTrades =
@ -712,16 +713,16 @@ instance TransaqResponseC ResponseAllTrades where
pure . ResponseAllTrades . catMaybes $ alltrades pure . ResponseAllTrades . catMaybes $ alltrades
where where
parseAllTrade tag = do parseAllTrade tag = do
attSecId <- findAttr (uname "secid") tag >>= readMaybe !attSecId <- findAttr (uname "secid") tag >>= readMaybe
attSecCode <- T.pack <$> childContent "seccode" tag !attSecCode <- T.pack <$> childContent "seccode" tag
attTradeNo <- childContent "tradeno" tag >>= readMaybe !attTradeNo <- childContent "tradeno" tag >>= readMaybe
attTimestamp <- T.pack <$> childContent "time" tag >>= parseTimestamp !attTimestamp <- T.pack <$> childContent "time" tag >>= parseTimestamp
attBoard <- T.pack <$> childContent "board" tag !attBoard <- T.pack <$> childContent "board" tag
attPrice <- childContent "price" tag >>= readMaybe !attPrice <- childContent "price" tag >>= readMaybe
attQuantity <- childContent "quantity" tag >>= readMaybe !attQuantity <- childContent "quantity" tag >>= readMaybe
attBuysell <- T.pack <$> childContent "buysell" tag >>= parseTradeDirection !attBuysell <- T.pack <$> childContent "buysell" tag >>= parseTradeDirection
let attOpenInterest = fromMaybe 0 $ childContent "openinterest" tag >>= readMaybe let !attOpenInterest = fromMaybe 0 $ childContent "openinterest" tag >>= readMaybe
let attPeriod = fromMaybe PeriodUnknown $ childContent "period" tag >>= parseTradingPeriod let !attPeriod = fromMaybe PeriodUnknown $ childContent "period" tag >>= parseTradingPeriod
pure . Just $ AllTradesTrade {..} pure . Just $ AllTradesTrade {..}
parseTradingPeriod :: String -> Maybe TradingPeriod parseTradingPeriod :: String -> Maybe TradingPeriod
@ -734,14 +735,14 @@ instance TransaqResponseC ResponseAllTrades where
data Quote = data Quote =
Quote Quote
{ {
secId :: Int secId :: !Int
, board :: T.Text , board :: !T.Text
, secCode :: T.Text , secCode :: !T.Text
, price :: Double , price :: !Double
, source :: T.Text , source :: T.Text
, yield :: Int , yield :: !Int
, buy :: Int , buy :: !Int
, sell :: Int , sell :: !Int
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseQuotes = newtype ResponseQuotes =
@ -754,14 +755,14 @@ instance TransaqResponseC ResponseQuotes where
pure . ResponseQuotes . catMaybes $ quotes pure . ResponseQuotes . catMaybes $ quotes
where where
parseQuote tag = do parseQuote tag = do
secId <- findAttr (uname "secid") tag >>= readMaybe !secId <- findAttr (uname "secid") tag >>= readMaybe
secCode <- T.pack <$> childContent "seccode" tag !secCode <- T.pack <$> childContent "seccode" tag
board <- T.pack <$> childContent "board" tag !board <- T.pack <$> childContent "board" tag
price <- childContent "price" tag >>= readMaybe !price <- childContent "price" tag >>= readMaybe
source <- T.pack <$> childContent "source" tag !source <- T.pack <$> childContent "source" tag
yield <- childContent "yield" tag >>= readMaybe !yield <- childContent "yield" tag >>= readMaybe
buy <- childContent "buy" tag >>= readMaybe !buy <- childContent "buy" tag >>= readMaybe
sell <- childContent "sell" tag >>= readMaybe !sell <- childContent "sell" tag >>= readMaybe
return . Just $ Quote {..} return . Just $ Quote {..}
data OrderStatus = data OrderStatus =
@ -784,21 +785,21 @@ data OrderStatus =
data OrderNotification = data OrderNotification =
OrderNotification OrderNotification
{ {
oTransactionId :: Int oTransactionId :: !Int
, oOrderNo :: Int64 , oOrderNo :: !Int64
, oSecId :: Int , oSecId :: !Int
, oBoard :: T.Text , oBoard :: !T.Text
, oSecCode :: T.Text , oSecCode :: !T.Text
, oClient :: T.Text , oClient :: !T.Text
, oUnion :: T.Text , oUnion :: !T.Text
, oStatus :: OrderStatus , oStatus :: !OrderStatus
, oBuysell :: TradeDirection , oBuysell :: !TradeDirection
, oTimestamp :: UTCTime , oTimestamp :: !UTCTime
, oBrokerRef :: T.Text , oBrokerRef :: !T.Text
, oBalance :: Int , oBalance :: !Int
, oPrice :: Double , oPrice :: !Double
, oQuantity :: Int , oQuantity :: !Int
, oResult :: T.Text , oResult :: !T.Text
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseOrders = newtype ResponseOrders =
@ -811,21 +812,21 @@ instance TransaqResponseC ResponseOrders where
pure . ResponseOrders . catMaybes $ quotes pure . ResponseOrders . catMaybes $ quotes
where where
parseOrder tag = do parseOrder tag = do
oTransactionId <- findAttr (uname "transactionid") tag >>= readMaybe !oTransactionId <- findAttr (uname "transactionid") tag >>= readMaybe
oOrderNo <- childContent "orderno" tag >>= readMaybe !oOrderNo <- childContent "orderno" tag >>= readMaybe
oSecId <- childContent "secid" tag >>= readMaybe !oSecId <- childContent "secid" tag >>= readMaybe
oBoard <- T.pack <$> childContent "board" tag !oBoard <- T.pack <$> childContent "board" tag
oSecCode <- T.pack <$> childContent "seccode" tag !oSecCode <- T.pack <$> childContent "seccode" tag
oClient <- T.pack <$> childContent "client" tag !oClient <- T.pack <$> childContent "client" tag
oUnion <- T.pack <$> childContent "union" tag !oUnion <- T.pack <$> childContent "union" tag
oStatus <- childContent "status" tag >>= parseStatus !oStatus <- childContent "status" tag >>= parseStatus
oBuysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack !oBuysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack
oTimestamp <- childContent "time" tag >>= parseTimestamp . T.pack !oTimestamp <- childContent "time" tag >>= parseTimestamp . T.pack
oBrokerRef <- T.pack <$> childContent "brokerref" tag !oBrokerRef <- T.pack <$> childContent "brokerref" tag
oBalance <- childContent "balance" tag >>= readMaybe !oBalance <- childContent "balance" tag >>= readMaybe
oPrice <- childContent "price" tag >>= readMaybe !oPrice <- childContent "price" tag >>= readMaybe
oQuantity <- childContent "quantity" tag >>= readMaybe !oQuantity <- childContent "quantity" tag >>= readMaybe
oResult <- T.pack <$> childContent "result" tag !oResult <- T.pack <$> childContent "result" tag
return . Just $ OrderNotification {..} return . Just $ OrderNotification {..}
parseStatus "active" = Just OrderActive parseStatus "active" = Just OrderActive
parseStatus "cancelled" = Just OrderCancelled parseStatus "cancelled" = Just OrderCancelled
@ -846,19 +847,19 @@ instance TransaqResponseC ResponseOrders where
data TradeNotification = data TradeNotification =
TradeNotification TradeNotification
{ {
tSecId :: Int tSecId :: !Int
, tTradeNo :: Int64 , tTradeNo :: !Int64
, tOrderNo :: Int64 , tOrderNo :: !Int64
, tBoard :: T.Text , tBoard :: !T.Text
, tSecCode :: T.Text , tSecCode :: !T.Text
, tClient :: T.Text , tClient :: !T.Text
, tUnion :: T.Text , tUnion :: !T.Text
, tBuysell :: TradeDirection , tBuysell :: !TradeDirection
, tTimestamp :: UTCTime , tTimestamp :: !UTCTime
, tValue :: Double , tValue :: !Double
, tComission :: Double , tComission :: !Double
, tQuantity :: Int , tQuantity :: !Int
, tPrice :: Double , tPrice :: !Double
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseTrades = newtype ResponseTrades =
@ -871,34 +872,34 @@ instance TransaqResponseC ResponseTrades where
pure . ResponseTrades . catMaybes $ quotes pure . ResponseTrades . catMaybes $ quotes
where where
parseTrade tag = do parseTrade tag = do
tSecId <- childContent "secid" tag >>= readMaybe !tSecId <- childContent "secid" tag >>= readMaybe
tTradeNo <- childContent "tradeno" tag >>= readMaybe !tTradeNo <- childContent "tradeno" tag >>= readMaybe
tOrderNo <- childContent "orderno" tag >>= readMaybe !tOrderNo <- childContent "orderno" tag >>= readMaybe
tBoard <- T.pack <$> childContent "board" tag !tBoard <- T.pack <$> childContent "board" tag
tSecCode <- T.pack <$> childContent "seccode" tag !tSecCode <- T.pack <$> childContent "seccode" tag
tClient <- T.pack <$> childContent "client" tag !tClient <- T.pack <$> childContent "client" tag
tUnion <- T.pack <$> childContent "union" tag !tUnion <- T.pack <$> childContent "union" tag
tBuysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack !tBuysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack
tTimestamp <- childContent "time" tag >>= parseTimestamp . T.pack !tTimestamp <- childContent "time" tag >>= parseTimestamp . T.pack
tValue <- childContent "value" tag >>= readMaybe !tValue <- childContent "value" tag >>= readMaybe
tComission <- childContent "comission" tag >>= readMaybe !tComission <- childContent "comission" tag >>= readMaybe
tQuantity <- childContent "quantity" tag >>= readMaybe !tQuantity <- childContent "quantity" tag >>= readMaybe
tPrice <- childContent "price" tag >>= readMaybe !tPrice <- childContent "price" tag >>= readMaybe
pure . Just $ TradeNotification {..} pure . Just $ TradeNotification {..}
data Tick = data Tick =
Tick Tick
{ {
secId :: Int secId :: !Int
, tradeNo :: Int64 , tradeNo :: !Int64
, timestamp :: UTCTime , timestamp :: !UTCTime
, price :: Double , price :: !Double
, quantity :: Int , quantity :: !Int
, period :: TradingPeriod , period :: !TradingPeriod
, buySell :: TradeDirection , buySell :: !TradeDirection
, openInterest :: Int , openInterest :: !Int
, board :: T.Text , board :: !T.Text
, secCode :: T.Text , secCode :: !T.Text
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
newtype ResponseTicks = newtype ResponseTicks =

Write Preview
Loading…
Cancel
Save