asakul
/
libatrade
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

Fix price <-> double conversion

master
Denis Tereshkin 6 years ago
parent
2142dac48e
commit
ef440f2036
4 changed files with 39 additions and 33 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. 4
      src/ATrade/Price.hs
  2. 13
      test/TestQuoteSourceClient.hs
  3. 7
      test/TestQuoteSourceServer.hs
  4. 46
      test/TestTypes.hs

4
src/ATrade/Price.hs
Unescape View File

@ -45,7 +45,9 @@ toDouble :: Price -> Double
toDouble p = fromIntegral (priceQuants p) / fromIntegral mega toDouble p = fromIntegral (priceQuants p) / fromIntegral mega
fromDouble :: Double -> Price fromDouble :: Double -> Price
fromDouble d = Price { priceQuants = truncate ((d * fromIntegral mega) + 0.5) } fromDouble d
| d >= 0 = Price { priceQuants = truncate ((d * fromIntegral mega) + 0.5) }
| otherwise = Price { priceQuants = truncate ((d * fromIntegral mega) - 0.5) }
toScientific :: Price -> Scientific toScientific :: Price -> Scientific
toScientific p = normalize $ scientific (toInteger $ priceQuants p) (-6) toScientific p = normalize $ scientific (toInteger $ priceQuants p) (-6)

13
test/TestQuoteSourceClient.hs
Unescape View File

@ -20,6 +20,7 @@ import Data.Time.Clock
import Data.UUID as U import Data.UUID as U
import Data.UUID.V4 as UV4 import Data.UUID.V4 as UV4
import System.ZMQ4 import System.ZMQ4
import System.ZMQ4.ZAP
makeEndpoint :: IO T.Text makeEndpoint :: IO T.Text
makeEndpoint = do makeEndpoint = do
@ -37,16 +38,16 @@ testStartStop = testCase "QuoteSource client connects and disconnects" $ withCon
ep <- makeEndpoint ep <- makeEndpoint
chan <- newBoundedChan 1000 chan <- newBoundedChan 1000
clientChan <- newBoundedChan 1000 clientChan <- newBoundedChan 1000
bracket (startQuoteSourceServer chan ctx ep Nothing) stopQuoteSourceServer (\_ -> bracket (startQuoteSourceServer chan ctx ep defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
bracket (startQuoteSourceClient clientChan [] ctx ep) stopQuoteSourceClient (const yield))) bracket (startQuoteSourceClient clientChan [] ctx ep defaultClientSecurityParams) stopQuoteSourceClient (const yield)))
testTickStream :: TestTree testTickStream :: TestTree
testTickStream = testCase "QuoteSource clients receives ticks" $ withContext (\ctx -> do testTickStream = testCase "QuoteSource clients receives ticks" $ withContext (\ctx -> do
ep <- makeEndpoint ep <- makeEndpoint
chan <- newBoundedChan 1000 chan <- newBoundedChan 1000
clientChan <- newBoundedChan 1000 clientChan <- newBoundedChan 1000
bracket (startQuoteSourceServer chan ctx ep Nothing) stopQuoteSourceServer (\_ -> bracket (startQuoteSourceServer chan ctx ep defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep) stopQuoteSourceClient (\_ -> do bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep defaultClientSecurityParams) stopQuoteSourceClient (\_ -> do
let tick = Tick { let tick = Tick {
security = "FOOBAR", security = "FOOBAR",
datatype = LastTradePrice, datatype = LastTradePrice,
@ -62,8 +63,8 @@ testBarStream = testCase "QuoteSource clients receives bars" $ withContext (\ctx
ep <- makeEndpoint ep <- makeEndpoint
chan <- newBoundedChan 1000 chan <- newBoundedChan 1000
clientChan <- newBoundedChan 1000 clientChan <- newBoundedChan 1000
bracket (startQuoteSourceServer chan ctx ep Nothing) stopQuoteSourceServer (\_ -> bracket (startQuoteSourceServer chan ctx ep defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep) stopQuoteSourceClient (\_ -> do bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep defaultClientSecurityParams) stopQuoteSourceClient (\_ -> do
let bar = Bar { let bar = Bar {
barSecurity = "FOOBAR", barSecurity = "FOOBAR",
barTimestamp = UTCTime (fromGregorian 2016 9 27) 16000, barTimestamp = UTCTime (fromGregorian 2016 9 27) 16000,

7
test/TestQuoteSourceServer.hs
Unescape View File

@ -15,6 +15,7 @@ import qualified Data.ByteString.Lazy as BL
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.Clock import Data.Time.Clock
import System.ZMQ4 import System.ZMQ4
import System.ZMQ4.ZAP
unitTests :: TestTree unitTests :: TestTree
unitTests = testGroup "QuoteSource.Server" [ unitTests = testGroup "QuoteSource.Server" [
@ -25,13 +26,13 @@ unitTests = testGroup "QuoteSource.Server" [
testStartStop :: TestTree testStartStop :: TestTree
testStartStop = testCase "QuoteSource Server starts and stops" $ withContext (\ctx -> do testStartStop = testCase "QuoteSource Server starts and stops" $ withContext (\ctx -> do
chan <- newBoundedChan 1000 chan <- newBoundedChan 1000
qss <- startQuoteSourceServer chan ctx "inproc://quotesource-server" Nothing qss <- startQuoteSourceServer chan ctx "inproc://quotesource-server" defaultServerSecurityParams
stopQuoteSourceServer qss) stopQuoteSourceServer qss)
testTickStream :: TestTree testTickStream :: TestTree
testTickStream = testCase "QuoteSource Server sends ticks" $ withContext (\ctx -> do testTickStream = testCase "QuoteSource Server sends ticks" $ withContext (\ctx -> do
chan <- newBoundedChan 1000 chan <- newBoundedChan 1000
bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" Nothing) stopQuoteSourceServer (\_ -> bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
withSocket ctx Sub (\s -> do withSocket ctx Sub (\s -> do
connect s "inproc://quotesource-server" connect s "inproc://quotesource-server"
subscribe s "FOOBAR" subscribe s "FOOBAR"
@ -51,7 +52,7 @@ testTickStream = testCase "QuoteSource Server sends ticks" $ withContext (\ctx -
testBarStream :: TestTree testBarStream :: TestTree
testBarStream = testCase "QuoteSource Server sends bars" $ withContext (\ctx -> do testBarStream = testCase "QuoteSource Server sends bars" $ withContext (\ctx -> do
chan <- newBoundedChan 1000 chan <- newBoundedChan 1000
bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" Nothing) stopQuoteSourceServer (\_ -> bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
withSocket ctx Sub (\s -> do withSocket ctx Sub (\s -> do
connect s "inproc://quotesource-server" connect s "inproc://quotesource-server"
subscribe s "FOOBAR" subscribe s "FOOBAR"

46
test/TestTypes.hs
Unescape View File

@ -1,21 +1,23 @@
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module TestTypes ( module TestTypes (
properties properties
) where ) where
import Test.Tasty import Test.Tasty
import Test.Tasty.QuickCheck as QC import Test.Tasty.QuickCheck as QC
import ATrade.Types import ATrade.Price as P
import ATrade.Price as P import ATrade.Types
import ArbitraryInstances () import ArbitraryInstances ()
import Data.Aeson import Data.Aeson
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import Debug.Trace import Debug.Trace
properties :: TestTree properties :: TestTree
properties = testGroup "Types" [ properties = testGroup "Types" [
@ -39,7 +41,7 @@ properties = testGroup "Types" [
testTickSerialization :: TestTree testTickSerialization :: TestTree
testTickSerialization = QC.testProperty "Deserialize serialized tick" testTickSerialization = QC.testProperty "Deserialize serialized tick"
(\tick -> case (deserializeTick . serializeTick) tick of (\tick -> case (deserializeTick . serializeTick) tick of
Just t -> tick == t Just t -> tick == t
Nothing -> False) Nothing -> False)
-- Adjust arbitrary instances of ticks, because body doesn't store security name -- Adjust arbitrary instances of ticks, because body doesn't store security name
@ -50,7 +52,7 @@ testTickBodySerialization = QC.testProperty "Deserialize serialized bunch of tic
case deserializeTickBody (serialized tick1 tick2) of case deserializeTickBody (serialized tick1 tick2) of
(rest, Just t1) -> case deserializeTickBody rest of (rest, Just t1) -> case deserializeTickBody rest of
(_, Just t2) -> tick1 == t1 && tick2 == t2 (_, Just t2) -> tick1 == t1 && tick2 == t2
_ -> False _ -> False
_ -> False)) _ -> False))
where where
serialized t1 t2 = serializeTickBody t1 `B.append` serializeTickBody t2 serialized t1 t2 = serializeTickBody t1 `B.append` serializeTickBody t2
@ -58,43 +60,43 @@ testTickBodySerialization = QC.testProperty "Deserialize serialized bunch of tic
testSignalIdSerialization :: TestTree testSignalIdSerialization :: TestTree
testSignalIdSerialization = QC.testProperty "Deserialize serialized SignalId" testSignalIdSerialization = QC.testProperty "Deserialize serialized SignalId"
(\sid -> case (decode . encode $ sid :: Maybe SignalId) of (\sid -> case (decode . encode $ sid :: Maybe SignalId) of
Just s -> s == sid Just s -> s == sid
Nothing -> False) Nothing -> False)
testOrderPriceSerialization :: TestTree testOrderPriceSerialization :: TestTree
testOrderPriceSerialization = QC.testProperty "Deserialize serialized OrderPrice" testOrderPriceSerialization = QC.testProperty "Deserialize serialized OrderPrice"
(\v -> case (decode . encode $ v :: Maybe OrderPrice) of (\v -> case (decode . encode $ v :: Maybe OrderPrice) of
Just s -> s == v Just s -> s == v
Nothing -> False) Nothing -> False)
testOperationSerialization :: TestTree testOperationSerialization :: TestTree
testOperationSerialization = QC.testProperty "Deserialize serialized Operation" testOperationSerialization = QC.testProperty "Deserialize serialized Operation"
(\v -> case (decode . encode $ v :: Maybe Operation) of (\v -> case (decode . encode $ v :: Maybe Operation) of
Just s -> s == v Just s -> s == v
Nothing -> False) Nothing -> False)
testOrderStateSerialization :: TestTree testOrderStateSerialization :: TestTree
testOrderStateSerialization = QC.testProperty "Deserialize serialized OrderState" testOrderStateSerialization = QC.testProperty "Deserialize serialized OrderState"
(\v -> case (decode . encode $ v :: Maybe OrderState) of (\v -> case (decode . encode $ v :: Maybe OrderState) of
Just s -> s == v Just s -> s == v
Nothing -> False) Nothing -> False)
testOrderSerialization :: TestTree testOrderSerialization :: TestTree
testOrderSerialization = QC.testProperty "Deserialize serialized Order" testOrderSerialization = QC.testProperty "Deserialize serialized Order"
(\v -> case (decode . encode $ v :: Maybe Order) of (\v -> case (decode . encode $ v :: Maybe Order) of
Just s -> s == v Just s -> s == v
Nothing -> False) Nothing -> False)
testTradeSerialization :: TestTree testTradeSerialization :: TestTree
testTradeSerialization = QC.testProperty "Deserialize serialized Trade" testTradeSerialization = QC.testProperty "Deserialize serialized Trade"
(\v -> case (decode . encode $ v :: Maybe Trade) of (\v -> case (decode . encode $ v :: Maybe Trade) of
Just s -> s == v Just s -> s == v
Nothing -> False) Nothing -> False)
testPrice1 :: TestTree testPrice1 :: TestTree
testPrice1 = QC.testProperty "fromDouble . toDouble $ Price" testPrice1 = QC.testProperty "fromDouble . toDouble $ Price" $
(\p -> let newp = (P.fromDouble . P.toDouble) p in QC.forAll (arbitrary `suchThat` (\x -> abs x < 100000000)) (\p -> let newp = (P.fromDouble . P.toDouble) p in
(abs (priceQuants newp - priceQuants p) < 1000)) (priceQuants newp == priceQuants p))
testPrice2 :: TestTree testPrice2 :: TestTree
testPrice2 = QC.testProperty "toDouble . fromDouble $ Price" $ testPrice2 = QC.testProperty "toDouble . fromDouble $ Price" $
@ -123,4 +125,4 @@ testBarSerialization :: TestTree
testBarSerialization = QC.testProperty "Deserialize serialized bar" testBarSerialization = QC.testProperty "Deserialize serialized bar"
(\(tf, bar) -> case deserializeBar (serializeBar tf bar) of (\(tf, bar) -> case deserializeBar (serializeBar tf bar) of
Just (tf', bar') -> bar == bar' && tf == tf' Just (tf', bar') -> bar == bar' && tf == tf'
Nothing -> False) Nothing -> False)

Write Preview
Loading…
Cancel
Save