|
|
|
@ -25,7 +25,7 @@ module Transaq.Parsing |
|
|
|
import Barbies.Bare (Bare, Covered) |
|
|
|
import Barbies.Bare (Bare, Covered) |
|
|
|
import Control.Applicative (many) |
|
|
|
import Control.Applicative (many) |
|
|
|
import Control.Error.Util (hush) |
|
|
|
import Control.Error.Util (hush) |
|
|
|
import Control.Exception |
|
|
|
import Control.Exception hiding (try) |
|
|
|
import Control.Monad (void, when) |
|
|
|
import Control.Monad (void, when) |
|
|
|
import Control.Monad.ST (ST, runST) |
|
|
|
import Control.Monad.ST (ST, runST) |
|
|
|
import Control.Monad.State (MonadState, State, execState, |
|
|
|
import Control.Monad.State (MonadState, State, execState, |
|
|
|
@ -58,7 +58,7 @@ import Text.Megaparsec (MonadParsec (takeWhileP), |
|
|
|
Parsec (..), ParsecT, anySingle, |
|
|
|
Parsec (..), ParsecT, anySingle, |
|
|
|
customFailure, lookAhead, oneOf, |
|
|
|
customFailure, lookAhead, oneOf, |
|
|
|
parse, runParserT, satisfy, single, |
|
|
|
parse, runParserT, satisfy, single, |
|
|
|
unexpected, (<|>)) |
|
|
|
try, unexpected, (<|>)) |
|
|
|
import Text.Megaparsec (optional) |
|
|
|
import Text.Megaparsec (optional) |
|
|
|
import qualified Text.Megaparsec.Error as ME |
|
|
|
import qualified Text.Megaparsec.Error as ME |
|
|
|
import Text.Megaparsec.Stream (Stream (..)) |
|
|
|
import Text.Megaparsec.Stream (Stream (..)) |
|
|
|
@ -355,7 +355,7 @@ instance FromPartial AllTradesTradeB where |
|
|
|
attQuantity partial <*> |
|
|
|
attQuantity partial <*> |
|
|
|
attBuysell partial <*> |
|
|
|
attBuysell partial <*> |
|
|
|
pure (fromMaybe 0 (attOpenInterest partial)) <*> |
|
|
|
pure (fromMaybe 0 (attOpenInterest partial)) <*> |
|
|
|
attPeriod partial |
|
|
|
pure (fromMaybe PeriodNormal $ attPeriod partial) |
|
|
|
|
|
|
|
|
|
|
|
type QuotePartial = Quote.QuoteB Covered Maybe |
|
|
|
type QuotePartial = Quote.QuoteB Covered Maybe |
|
|
|
deriving instance Eq QuotePartial |
|
|
|
deriving instance Eq QuotePartial |
|
|
|
@ -733,10 +733,15 @@ parseMarkets = do |
|
|
|
parseSecurities :: ParsecT String [XmlStreamEvent] (ST s) TransaqResponse |
|
|
|
parseSecurities :: ParsecT String [XmlStreamEvent] (ST s) TransaqResponse |
|
|
|
parseSecurities = do |
|
|
|
parseSecurities = do |
|
|
|
void . single $ XmlOpenEnd "securities" |
|
|
|
void . single $ XmlOpenEnd "securities" |
|
|
|
securities <- catMaybes <$> many parseSecurity |
|
|
|
securities <- catMaybes <$> many (try parseSecurity <|> ignoreSecurity) |
|
|
|
void . single $ XmlClose "securities" |
|
|
|
void . single $ XmlClose "securities" |
|
|
|
pure . TransaqResponseSecurities . ResponseSecurities $ securities |
|
|
|
pure . TransaqResponseSecurities . ResponseSecurities $ securities |
|
|
|
where |
|
|
|
where |
|
|
|
|
|
|
|
ignoreSecurity = do |
|
|
|
|
|
|
|
void . single $ XmlOpen "security" |
|
|
|
|
|
|
|
ignoreTag "security" |
|
|
|
|
|
|
|
pure Nothing |
|
|
|
|
|
|
|
|
|
|
|
parseSecurity :: ParsecT String [XmlStreamEvent] (ST s) (Maybe Security) |
|
|
|
parseSecurity :: ParsecT String [XmlStreamEvent] (ST s) (Maybe Security) |
|
|
|
parseSecurity = do |
|
|
|
parseSecurity = do |
|
|
|
ref <- lift $ newSTRef emptyPartial |
|
|
|
ref <- lift $ newSTRef emptyPartial |
|
|
|
@ -868,7 +873,7 @@ parseAllTrades = do |
|
|
|
many (parseTradeField ref) |
|
|
|
many (parseTradeField ref) |
|
|
|
void . single $ XmlClose "trade" |
|
|
|
void . single $ XmlClose "trade" |
|
|
|
result <- lift $ readSTRef ref |
|
|
|
result <- lift $ readSTRef ref |
|
|
|
pure . fromPartial $ result |
|
|
|
pure $ fromPartial $ result |
|
|
|
|
|
|
|
|
|
|
|
parseTradeField ref = do |
|
|
|
parseTradeField ref = do |
|
|
|
openTag <- satisfy isOpenTag |
|
|
|
openTag <- satisfy isOpenTag |
|
|
|
@ -1065,9 +1070,15 @@ parseTimestamp = hush . parseOnly parser |
|
|
|
|
|
|
|
|
|
|
|
parseTextTag tagname ref f = do |
|
|
|
parseTextTag tagname ref f = do |
|
|
|
void . single $ XmlOpenEnd tagname |
|
|
|
void . single $ XmlOpenEnd tagname |
|
|
|
(XmlText txt) <- satisfy isText |
|
|
|
x <- anySingle |
|
|
|
lift $ modifySTRef' ref (f txt) |
|
|
|
case x of |
|
|
|
void . single $ XmlClose tagname |
|
|
|
(XmlText txt) -> do |
|
|
|
|
|
|
|
lift $ modifySTRef' ref (f txt) |
|
|
|
|
|
|
|
void . single $ XmlClose tagname |
|
|
|
|
|
|
|
(XmlClose tagname) -> |
|
|
|
|
|
|
|
lift $ modifySTRef' ref (f "") |
|
|
|
|
|
|
|
_ -> customFailure "Invalid text tag" |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ignoreTag tagname = do |
|
|
|
ignoreTag tagname = do |
|
|
|
x <- takeWhileP Nothing (/= XmlClose tagname) |
|
|
|
x <- takeWhileP Nothing (/= XmlClose tagname) |
|
|
|
|