{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE QuasiQuotes         #-}

module Test.Transaq.Parsing
  (
    unitTests
  ) where

import           Control.Monad.State (execState)
import           Data.AEq            ((~==))
import qualified Data.ByteString     as BS
import           Test.Tasty          (TestTree, testGroup)
import           Test.Tasty.HUnit    (assertBool, assertFailure, testCase,
                                      (@=?))
import           Text.RawString.QQ
import           Transaq             (AllTradesTradeB (..), CandleB (..),
                                      CandleKind, CandleKindB (..),
                                      ClientDataB (..), ConnectionState (..),
                                      MarketInfoB (..), OrderNotificationB (..),
                                      OrderStatus (..), QuotationB (..),
                                      QuoteB (..), ResponseAllTrades (..),
                                      ResponseCandleKinds (..),
                                      ResponseCandlesB (..),
                                      ResponseCandlesStatus (..),
                                      ResponseClient (..), ResponseMarkets (..),
                                      ResponseOrders (..),
                                      ResponseQuotations (..),
                                      ResponseQuotes (..), ResponseResult (..),
                                      ResponseSecInfoB (..),
                                      ResponseSecurities (..),
                                      ResponseServerStatusB (..),
                                      ResponseTrades (..), SecurityB (..),
                                      SecurityId (..), TradeDirection (..),
                                      TradeNotificationB (..),
                                      TradingPeriod (..), TransaqResponse (..))
import           Transaq.Parsing
import           Xeno.SAX            (process)

unitTests :: TestTree
unitTests = testGroup "Parsing"
  [
    unitTestsStreaming
  ]

unitTestsStreaming :: TestTree
unitTestsStreaming = testGroup "Parsing via xeno-sax"
  [
    testParseResultStreaming
  , testParseClientStreaming
  , testParseCandleKindsStreaming
  , testParseCandlesStreaming
  , testParseServerStatusStreaming
  , testParseMarketsStreaming
  , testParseSecuritiesStreaming
  , testParseSecInfoStreaming
  , testParseQuotationsStreaming
  , testParseAllTradesStreaming
  , testParseQuotesStreaming
  , testParseOrdersStreaming
  , testParseTradesStreaming
  ]

testParseResultStreaming :: TestTree
testParseResultStreaming = testGroup "Parsing result"
  [
    testParseResultSuccess
  , testParseResultSuccessWithTransactionId
  , testParseResultFailure
  ]
  where
    resultSuccess = [r|<result success="true" />|] :: BS.ByteString
    testParseResultSuccess = testCase "Parse success result" $ do
      [TransaqResponseResult (ResponseSuccess Nothing)] @=?
           parseTransaqResponses resultSuccess

    resultSuccessWithTransactionId = [r|<result success="true" transactionid="12" />|] :: BS.ByteString
    testParseResultSuccessWithTransactionId = testCase "Parse success result with transaction ID" $ do
      [TransaqResponseResult (ResponseSuccess (Just 12))] @=?
           parseTransaqResponses resultSuccessWithTransactionId

    resultFailure = [r|<result success="false" />|] :: BS.ByteString
    testParseResultFailure = testCase "Parse failure result" $ do
      [TransaqResponseResult (ResponseFailure "")] @=?
           parseTransaqResponses resultFailure

testParseClientStreaming :: TestTree
testParseClientStreaming = testCase "Parse ResponseClient - valid XML" $ do
  case parseTransaqResponses validClient of
    [TransaqResponseClient (ResponseClient clientData)] -> do
      "FOO" @=? cClientId clientData
      "TYPE" @=? cType clientData
      "CURRENCY" @=? cCurrency clientData
      "MARKET" @=? cMarket clientData
      "UNION" @=? cUnion clientData
      Just "FORTS_ACC" @=? cForts clientData
    _ -> assertFailure "Invalid <client> parse"
  where
    validClient =
      [r|
        <client id="FOO">
          <type>TYPE</type>
          <currency>CURRENCY</currency>
          <market>MARKET</market>
          <union>UNION</union>
          <forts_acc>FORTS_ACC</forts_acc>
        </client>
        |] :: BS.ByteString

testParseCandleKindsStreaming :: TestTree
testParseCandleKindsStreaming = testCase "Parse CandleKind - valid XML" $ do
  let candleKinds = parseTransaqResponses validCandleKinds

  let [TransaqResponseCandleKinds (ResponseCandleKinds [m10, m15])] = candleKinds

  4 @=? kCandleKindId m10
  600 @=? kPeriod m10
  "M10" @=? kName m10

  5 @=? kCandleKindId m15
  900 @=? kPeriod m15
  "M15" @=? kName m15
  where
    validCandleKinds =
      [r|
        <candlekinds>
          <kind>
            <id>4</id>
            <period>600</period>
            <name>M10</name>
          </kind>
          <kind>
            <id>5</id>
            <period>900</period>
            <name>M15</name>
          </kind>
        </candlekinds>
        |] :: BS.ByteString

testParseCandlesStreaming :: TestTree
testParseCandlesStreaming = testCase "Parse Candles - valid XML" $ do
  let [TransaqResponseCandles responseCandles] = parseTransaqResponses validCandles
  SecurityId "foo" "bar" @=? cSecurity responseCandles
  1 @=? cPeriodId responseCandles
  StatusEndOfHistory @=? cStatus responseCandles
  1 @=? (length . cCandles) responseCandles
  let candle = head . cCandles $ responseCandles
  assertBool "Candle open mismatch" (41.3 ~== cOpen candle)
  assertBool "Candle high mismatch" (42 ~== cHigh candle)
  assertBool "Candle low mismatch" (40 ~== cLow candle)
  assertBool "Candle close mismatch" (41.6 ~== cClose candle)
  1234 @=? cVolume candle
  78 @=? cOpenInterest candle
  where
    validCandles =
      [r|
        <candles secid="12" period="1" status="0" board="foo" seccode="bar">
          <candle date="05.01.2024 12:30:00.123" open="41.3" high="42" low="40" close="41.6" volume="1234" oi="78" />
        </candles>
        |] :: BS.ByteString

testParseServerStatusStreaming :: TestTree
testParseServerStatusStreaming = testCase "Parse ServerStatus - valid XML" $ do
  let [TransaqResponseServerStatus serverStatus] = parseTransaqResponses validServerStatus
  Just 22 @=? serverId serverStatus
  Connected @=? state serverStatus
  Just True @=? recover serverStatus
  Just "TZ" @=? serverTimezone serverStatus
  Just 42 @=? systemVersion serverStatus
  Just 51 @=? build serverStatus
  where
    validServerStatus =
      [r|<server_status id="22" connected="true" recover="true" server_tz="TZ" sys_ver="42" build="51" /> |] :: BS.ByteString


testParseMarketsStreaming :: TestTree
testParseMarketsStreaming = testCase "Parse ResponseMarkets - valid XML" $ do
  let markets = parseTransaqResponses validMarkets

  let [TransaqResponseMarkets (ResponseMarkets [foo, bar])] = markets

  1 @=? marketId foo
  "FOO" @=? marketName foo

  2 @=? marketId bar
  "BAR" @=? marketName bar
  where
    validMarkets =
      [r|
        <markets>
          <market id="1">FOO</market>
          <market id="2">BAR</market>
        </markets>
        |] :: BS.ByteString


testParseSecuritiesStreaming :: TestTree
testParseSecuritiesStreaming = testCase "Parse ResponseSecurities - valid XML" $ do
  let [TransaqResponseSecurities (ResponseSecurities securities)] = parseTransaqResponses validSecurities
  1 @=? length securities

  let sec = head securities
  "SECCODE" @=? sSeccode sec
  "CLASS" @=? sInstrClass sec
  "BOARD" @=? sBoard sec
  "15" @=? sMarket sec
  "CURRENCY" @=? sCurrency sec
  "SHORTNAME" @=? sShortName sec
  3 @=? sDecimals sec
  assertBool "Minstep is not valid" (0.1 ~== sMinStep sec)
  10 @=? sLotSize sec
  1 @=? sLotDivider sec
  assertBool "Point cost is not valid" (6.28 ~== sPointCost sec)
  "SECTYPE" @=? sSecType sec
  where
    validSecurities =
      [r|
        <securities>
          <security secid="1" active="true">
            <seccode>SECCODE</seccode>
            <instrclass>CLASS</instrclass>
            <board>BOARD</board>
            <market>15</market>
            <currency>CURRENCY</currency>
            <shortname>SHORTNAME</shortname>
            <decimals>3</decimals>
            <minstep>0.1</minstep>
            <lotsize>10</lotsize>
            <lotdivider>1</lotdivider>
            <point_cost>6.28</point_cost>
            <optmask usecredit="yes" bymarket="no" nosplit="yes" fok="no" ioc="no" />
            <sectype>SECTYPE</sectype>
            <sec_tz>SECTZ</sec_tz>
            <quotestype>1</quotestype>
            <MIC>FOO</MIC>
            <currencyid>CURRENCYID</currencyid>
          </security>
        </securities>
        |] :: BS.ByteString

testParseSecInfoStreaming :: TestTree
testParseSecInfoStreaming = testCase "Parse ResponseSecInfo - valid XML" $ do
  let [TransaqResponseSecInfo sec] = parseTransaqResponses validSecInfo

  "SECNAME" @=? secName sec
  "SECCODE" @=? sec.secCode
  44 @=? market sec
  "PNAME" @=? pname sec
  assertBool "Clearing price is not valid" (12.34 ~== clearingPrice sec)
  assertBool "Min price is not valid" (10 ~== minPrice sec)
  assertBool "Max price is not valid" (20 ~== maxPrice sec)
  assertBool "Point cost is not valid" (6.28 ~== pointCost sec)
  where
    validSecInfo =
      [r|
        <sec_info secid="4">
          <secname>SECNAME</secname>
          <seccode>SECCODE</seccode>
          <market>44</market>
          <pname>PNAME</pname>
          <clearing_price>12.34</clearing_price>
          <minprice>10</minprice>
          <maxprice>20</maxprice>
          <point_cost>6.28</point_cost>
        </sec_info>
        |] :: BS.ByteString

testParseQuotationsStreaming :: TestTree
testParseQuotationsStreaming = testCase "Parse ResponseQuotations - valid XML (full)" $ do
  let [TransaqResponseQuotations (ResponseQuotations quotations)] = parseTransaqResponses validQuotations
  1 @=? length quotations

  let q = head quotations

  1 @=? qSecId q
  "BOARD" @=? qBoard q
  "SECCODE" @=? qSeccode q

  let (Just open') = qOpen q
  assertBool "Open is not valid" (12.34 ~== open')

  let (Just waprice') = qWaprice q
  assertBool "WA price is not valid" (13.8 ~== waprice')

  Just 40 @=? qBidDepth q
  Just 140 @=? qBidDepthT q
  Just 10 @=? qNumBids q

  let (Just bid') = qBid q
  assertBool "Bid is not valid" (11.01 ~== bid')

  Just 50 @=? qOfferDepth q
  Just 150 @=? qOfferDepthT q
  Just 15 @=? qNumOffers q

  let (Just offer') = qOffer q
  assertBool "Offer is not valid" (11.05 ~== offer')

  Just 1000 @=? qNumTrades q
  Just 50000 @=? qVolToday q
  Just 1000 @=? qOpenPositions q

  let (Just last') = qLastPrice q
  assertBool "Last price is not valid" (11.03 ~== last')

  Just 8 @=? qQuantity q

  -- TODO check time

  let (Just valtoday') = qValToday q
  assertBool "Val today is not valid" (12345678 ~== valtoday')
  where
    validQuotations =
      [r|
        <quotations>
          <quotation secid="1">
            <board>BOARD</board>
            <seccode>SECCODE</seccode>
            <open>12.34</open>
            <waprice>13.8</waprice>
            <biddepth>40</biddepth>
            <biddeptht>140</biddeptht>
            <numbids>10</numbids>
            <bid>11.01</bid>
            <offerdepth>50</offerdepth>
            <offerdeptht>150</offerdeptht>
            <numoffers>15</numoffers>
            <offer>11.05</offer>
            <numtrades>1000</numtrades>
            <voltoday>50000</voltoday>
            <openpositions>1000</openpositions>
            <last>11.03</last>
            <quantity>8</quantity>
            <time>05.01.2024 19:34:18.234</time>
            <valtoday>12345678</valtoday>
          </quotation>
        </quotations>
        |] :: BS.ByteString

testParseAllTradesStreaming :: TestTree
testParseAllTradesStreaming = testCase "Parse ResponseAllTrades - valid XML (full)" $ do
  let [TransaqResponseAllTrades (ResponseAllTrades trades)] = parseTransaqResponses validAllTrades
  2 @=? length trades

  let [t1, t2] = trades

  1 @=? attSecId t1
  "SEC1" @=? attSecCode t1
  14 @=? attTradeNo t1
  -- TODO check time
  "BOARD" @=? attBoard t1
  assertBool "Price is not valid" (12.34 ~== attPrice t1)
  10 @=? attQuantity t1
  Buy @=? attBuysell t1
  100 @=? attOpenInterest t1
  PeriodNormal @=? attPeriod t1

  2 @=? attSecId t2
  "SEC2" @=? attSecCode t2
  15 @=? attTradeNo t2
  -- TODO check time
  "BOARD" @=? attBoard t2
  assertBool "Price is not valid" (12.35 ~== attPrice t2)
  11 @=? attQuantity t2
  Sell @=? attBuysell t2
  200 @=? attOpenInterest t2
  PeriodNormal @=? attPeriod t2
  where
    validAllTrades =
      [r|
        <alltrades>
          <trade secid="1">
            <seccode>SEC1</seccode>
            <tradeno>14</tradeno>
            <time>05.01.2024 19:34:18.234</time>
            <board>BOARD</board>
            <price>12.34</price>
            <quantity>10</quantity>
            <buysell>B</buysell>
            <openinterest>100</openinterest>
            <period>N</period>
          </trade>
          <trade secid="2">
            <seccode>SEC2</seccode>
            <tradeno>15</tradeno>
            <time>05.01.2024 19:34:19.234</time>
            <board>BOARD</board>
            <price>12.35</price>
            <quantity>11</quantity>
            <buysell>S</buysell>
            <openinterest>200</openinterest>
            <period>N</period>
          </trade>
        </alltrades>
        |] :: BS.ByteString

testParseQuotesStreaming :: TestTree
testParseQuotesStreaming = testCase "Parse ResponseQuotes - valid XML (full)" $ do
  let [TransaqResponseQuotes (ResponseQuotes quotes)] = parseTransaqResponses validQuotes
  2 @=? length quotes

  let [q1, q2] = quotes

  1 @=? q1.secId
  "BOARD" @=? q1.board
  assertBool "Price is not valid" (12.34 ~== q1.price)
  Just "SOURCE" @=? q1.source
  Just 10 @=? q1.buy
  Nothing @=? q1.sell

  2 @=? q2.secId
  "BOARD" @=? q2.board
  assertBool "Price is not valid" (12.35 ~== q2.price)
  Just "SOURCE" @=? q2.source
  Nothing @=? q2.buy
  Just 11 @=? q2.sell
  where
    validQuotes =
      [r|
        <quotes>
          <quote secid="1">
            <board>BOARD</board>
            <seccode>SEC1</seccode>
            <price>12.34</price>
            <source>SOURCE</source>
            <buy>10</buy>
          </quote>
          <quote secid="2">
            <board>BOARD</board>
            <seccode>SEC2</seccode>
            <price>12.35</price>
            <source>SOURCE</source>
            <sell>11</sell>
          </quote>
        </quotes>
        |] :: BS.ByteString

testParseOrdersStreaming :: TestTree
testParseOrdersStreaming = testCase "Parse ResponseOrders - valid XML (full)" $ do
  let [TransaqResponseOrders (ResponseOrders orders)] = parseTransaqResponses validOrders
  1 @=? length orders

  let order = head orders

  12 @=? oTransactionId order
  42 @=? oOrderNo order
  1 @=? oSecId order
  "BOARD" @=? oBoard order
  "SEC1" @=? oSecCode order
  Just "CLIENT" @=? oClient order
  Just "UNION" @=? oUnion order
  Just OrderActive @=? oStatus order
  Just Buy @=? oBuysell order

  let Just price' = oPrice order
  assertBool "Price is not valid" (12.34 ~== price')

  Just 12 @=? oQuantity order

  where
    validOrders =
      [r|
        <orders>
          <order transactionid="12">
            <orderno>42</orderno>
            <secid>1</secid>
            <board>BOARD</board>
            <seccode>SEC1</seccode>
            <client>CLIENT</client>
            <union>UNION</union>
            <status>active</status>
            <buysell>B</buysell>
            <time>05.01.2024 19:34:19.234</time>
            <price>12.34</price>
            <quantity>12</quantity>
          </order>
        </orders>
        |] :: BS.ByteString

testParseTradesStreaming :: TestTree
testParseTradesStreaming = testCase "Parse ResponseTrades - valid XML (full)" $ do
  let [TransaqResponseTrades (ResponseTrades trades)] = parseTransaqResponses validTrades
  1 @=? length trades

  let trade = head trades

  1 @=? tSecId trade
  12 @=? tTradeNo trade
  42 @=? tOrderNo trade
  "BOARD" @=? tBoard trade
  "SEC1" @=? tSecCode trade
  "CLIENT" @=? tClient trade
  "UNION" @=? tUnion trade
  Buy @=? tBuysell trade
  -- TODO check time

  True @=? (123.4 ~== tValue trade)
  True @=? (0.5 ~== tComission trade)
  10 @=? tQuantity trade
  True @=? (12.34 ~== tPrice trade)
  where
    validTrades =
      [r|
        <trades>
          <trade>
            <secid>1</secid>
            <tradeno>12</tradeno>
            <orderno>42</orderno>
            <board>BOARD</board>
            <seccode>SEC1</seccode>
            <client>CLIENT</client>
            <union>UNION</union>
            <buysell>B</buysell>
            <time>05.01.2024 19:34:19.234</time>
            <value>123.40</value>
            <comission>0.5</comission>
            <quantity>10</quantity>
            <price>12.34</price>
          </trade>
        </trades>
        |] :: BS.ByteString