Browse Source

fix security parsing

master
Denis Tereshkin 2 years ago
parent
commit
8ba3bf336e
  1. 27
      src/Transaq/Parsing.hs

27
src/Transaq/Parsing.hs

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

Loading…
Cancel
Save