From 9de7b4a353505003b891679319187dd3b32169c1 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Tue, 27 Sep 2016 13:48:46 +0700 Subject: [PATCH] More types and their serialization/deserialization tests --- libatrade.cabal | 3 + src/ATrade/Types.hs | 171 +++++++++++++++++++++++++++++++++++++++++--- test/TestTypes.hs | 85 ++++++++++++++++++++-- 3 files changed, 242 insertions(+), 17 deletions(-) diff --git a/libatrade.cabal b/libatrade.cabal index 845932a..3c8a193 100644 --- a/libatrade.cabal +++ b/libatrade.cabal @@ -23,6 +23,7 @@ library , bytestring , text , binary + , aeson default-language: Haskell2010 executable libatrade-exe @@ -52,6 +53,8 @@ test-suite libatrade-test , scientific , tuple , time + , aeson + , text ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 diff --git a/src/ATrade/Types.hs b/src/ATrade/Types.hs index 7ab325c..6fbd9b3 100644 --- a/src/ATrade/Types.hs +++ b/src/ATrade/Types.hs @@ -1,25 +1,33 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-} module ATrade.Types ( Tick(..), DataType(..), serializeTick, - deserializeTick + deserializeTick, + SignalId(..), + OrderPrice(..), + Operation(..), + OrderState(..), + Order(..) ) where -import Data.Decimal -import Data.Time.Clock -import Data.DateTime -import Data.ByteString.Lazy as B -import Data.Text as T -import Data.Text.Encoding as E -import Data.List as L +import Control.Monad +import Data.Aeson +import Data.Aeson.Types import Data.Binary.Builder import Data.Binary.Get +import Data.ByteString.Lazy as B +import Data.DateTime +import Data.Decimal import Data.Int -import Data.Word +import Data.List as L +import Data.Maybe import Data.Ratio -import Control.Monad +import Data.Text as T +import Data.Text.Encoding as E +import Data.Time.Clock +import Data.Word data DataType = Unknown | Price @@ -121,3 +129,144 @@ deserializeTick (header:rawData:_) = case runGetOrFail parseTick rawData of r = toInteger nanopart % 1000000000 deserializeTick _ = Nothing + +data SignalId = SignalId { + strategyId :: T.Text, + signalName :: T.Text, + comment :: T.Text } + deriving (Show, Eq) + +instance FromJSON SignalId where + parseJSON (Object o) = SignalId <$> + o .: "strategy-id" .!= "" <*> + o .: "signal-name" .!= "" <*> + o .: "comment" .!= "" + parseJSON _ = fail "Should be object" + +instance ToJSON SignalId where + toJSON sid = object [ "strategy-id" .= strategyId sid, + "signal-name" .= signalName sid, + "comment" .= comment sid ] + +instance FromJSON Decimal where + parseJSON = withScientific "number" (return . realFracToDecimal 10 . toRational) + +instance ToJSON Decimal where + toJSON = Number . fromRational . toRational + +data OrderPrice = Market | Limit Decimal | Stop Decimal Decimal | StopMarket Decimal + deriving (Show, Eq) + +decimal :: (RealFrac r) => r -> Decimal +decimal = realFracToDecimal 10 + +instance FromJSON OrderPrice where + parseJSON (String s) = when (s /= "market") (fail "If string, then should be 'market'") >> + return Market + + parseJSON (Number n) = return $ Limit $ decimal n + parseJSON (Object v) = do + triggerPrice <- v .: "trigger" :: Parser Double + execPrice <- v .: "execution" + case execPrice of + (String s) -> when (s /= "market") (fail "If string, then should be 'market'") >> return $ StopMarket (decimal triggerPrice) + (Number n) -> return $ Stop (decimal triggerPrice) (decimal n) + _ -> fail "Should be either number or 'market'" + + parseJSON _ = fail "OrderPrice" + +instance ToJSON OrderPrice where + toJSON op = case op of + Market -> String "market" + (Limit d) -> Number $ convert d + (Stop t e) -> object [ "trigger" .= convert t, "execution" .= convert e ] + (StopMarket t) -> object [ "trigger" .= convert t, "execution" .= ("market" :: Text) ] + where + convert = fromRational . toRational + +data Operation = Buy | Sell + deriving (Show, Eq) + +instance FromJSON Operation where + parseJSON (String s) + | s == "buy" = return Buy + | s == "sell" = return Sell + | otherwise = fail "Should be either 'buy' or 'sell'" + parseJSON _ = fail "Should be string" + +instance ToJSON Operation where + toJSON Buy = String "buy" + toJSON Sell = String "sell" + +data OrderState = Unsubmitted + | Submitted + | PartiallyExecuted + | Executed + | Cancelled + | Rejected + | OrderError + deriving (Show, Eq) + +instance FromJSON OrderState where + parseJSON (String s) + | s == "unsubmitted" = return Unsubmitted + | s == "submitted" = return Submitted + | s == "partially-executed" = return PartiallyExecuted + | s == "executed" = return Executed + | s == "cancelled" = return Cancelled + | s == "rejected" = return Rejected + | s == "error" = return OrderError + | otherwise = fail "Invlaid state" + + parseJSON _ = fail "Should be string" + +instance ToJSON OrderState where + toJSON os = case os of + Unsubmitted -> String "unsubmitted" + Submitted -> String "submitted" + PartiallyExecuted -> String "partially-executed" + Executed -> String "executed" + Cancelled -> String "cancelled" + Rejected -> String "rejected" + OrderError -> String "error" + +type OrderId = Integer + +data Order = Order { + orderId :: OrderId, + orderAccountId :: String, + orderSecurity :: String, + orderPrice :: OrderPrice, + orderQuantity :: Integer, + orderExecutedQuantity :: Integer, + orderOperation :: Operation, + orderState :: OrderState, + orderSignalId :: SignalId } + deriving (Show, Eq) + +instance FromJSON Order where + parseJSON (Object v) = Order <$> + v .:? "order-id" .!= 0 <*> + v .: "account" <*> + v .: "security" <*> + v .: "price" <*> + v .: "quantity" <*> + v .:? "executed-quantity" .!= 0 <*> + v .: "operation" <*> + v .: "state" .!= Unsubmitted <*> + v .: "signal-id" + + parseJSON _ = fail "Should be string" + +instance ToJSON Order where + toJSON order = object $ base ++ catMaybes [ifMaybe "order-id" (/= 0) (orderId order), ifMaybe "executed-quantity" (/= 0) (orderExecutedQuantity order)] + where + base = [ "account" .= orderAccountId order, + "security" .= orderSecurity order, + "price" .= orderPrice order, + "quantity" .= orderQuantity order, + "operation" .= orderOperation order, + "state" .= orderState order, + "signal-id" .= orderSignalId order ] + ifMaybe :: (ToJSON a, KeyValue b) => Text -> (a -> Bool) -> a -> Maybe b + ifMaybe name pred val = if pred val then Just (name .= val) else Nothing diff --git a/test/TestTypes.hs b/test/TestTypes.hs index 4bf87fd..1cac414 100644 --- a/test/TestTypes.hs +++ b/test/TestTypes.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE MultiWayIf #-} module TestTypes ( properties @@ -8,22 +9,27 @@ import Test.Tasty import Test.Tasty.SmallCheck as SC import Test.Tasty.QuickCheck as QC import Test.Tasty.HUnit +import Test.QuickCheck.Instances hiding (Text) import ATrade.Types + +import Data.Aeson +import Data.Aeson.Types import Data.Decimal -import Data.Time.Clock -import Data.Time.Calendar import Data.Scientific +import Data.Text +import Data.Time.Calendar +import Data.Time.Clock import Data.Tuple.Select -import Test.QuickCheck.Instances hiding (Text) +notTooBig x = abs x < 1000000000000 instance Arbitrary Tick where arbitrary = Tick <$> arbitrary <*> arbitrary <*> arbitraryTimestamp <*> - (roundTo 9 <$> (arbitrary `suchThat` (\x -> abs x < 1000000000000))) <*> + (roundTo 9 <$> (arbitrary `suchThat` notTooBig)) <*> arbitrary where arbitraryTimestamp = do @@ -41,10 +47,77 @@ instance Arbitrary DataType where instance Arbitrary Decimal where arbitrary = realFracToDecimal 10 <$> (arbitrary :: Gen Scientific) -properties = testGroup "Types" [ testTickSerialization ] +instance Arbitrary SignalId where + arbitrary = SignalId <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary OrderPrice where + arbitrary = do + v <- choose (1, 4) :: Gen Int + if | v == 1 -> return Market + | v == 2 -> Limit <$> arbitrary `suchThat` notTooBig + | v == 3 -> Stop <$> arbitrary `suchThat` notTooBig <*> arbitrary `suchThat` notTooBig + | v == 4 -> StopMarket <$> arbitrary `suchThat` notTooBig + | otherwise -> fail "Invalid case" + +instance Arbitrary Operation where + arbitrary = elements [Buy, Sell] + +instance Arbitrary OrderState where + arbitrary = elements [Unsubmitted, + Submitted, + PartiallyExecuted, + Executed, + Cancelled, + Rejected, + OrderError ] + +instance Arbitrary Order where + arbitrary = Order <$> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary + +properties = testGroup "Types" [ + testTickSerialization + , testSignalIdSerialization + , testOrderPriceSerialization + , testOperationSerialization + , testOrderStateSerialization + , testOrderSerialization + ] testTickSerialization = QC.testProperty "Deserialize serialized tick" (\tick -> case (deserializeTick . serializeTick) tick of Just t -> tick == t Nothing -> False) +testSignalIdSerialization = QC.testProperty "Deserialize serialized SignalId" + (\sid -> case (decode . encode $ sid :: Maybe SignalId) of + Just s -> s == sid + Nothing -> False) + +testOrderPriceSerialization = QC.testProperty "Deserialize serialized OrderPrice" + (\v -> case (decode . encode $ v :: Maybe OrderPrice) of + Just s -> s == v + Nothing -> False) + +testOperationSerialization = QC.testProperty "Deserialize serialized Operation" + (\v -> case (decode . encode $ v :: Maybe Operation) of + Just s -> s == v + Nothing -> False) + +testOrderStateSerialization = QC.testProperty "Deserialize serialized OrderState" + (\v -> case (decode . encode $ v :: Maybe OrderState) of + Just s -> s == v + Nothing -> False) + +testOrderSerialization = QC.testProperty "Deserialize serialized Order" + (\v -> case (decode . encode $ v :: Maybe Order) of + Just s -> s == v + Nothing -> False)