New type Price

libatrade.cabal

@@ -17,6 +17,7 @@ library
   hs-source-dirs:      src
   ghc-options:         -Wincomplete-patterns
   exposed-modules:     ATrade.Types
+                     , ATrade.Price
                      , ATrade.QuoteSource.Client
                      , ATrade.QuoteSource.Server
                      , ATrade.Broker.Client

src/ATrade/Price.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE MultiWayIf #-}
+
+module ATrade.Price (
+  Price(..),
+  fromDouble,
+  toDouble
+) where
+
+import Data.Int
+
+data Price = Price {
+  priceQuants :: !Int64
+} deriving (Eq, Show, Ord)
+
+giga :: Int64
+giga = 1000000000
+
+instance Num Price where
+  a + b = Price {
+    priceQuants = priceQuants a + priceQuants b }
+
+  a * b = Price {
+    priceQuants = (priceQuants a * priceQuants b) `div` giga }
+
+  abs a = a { priceQuants = abs (priceQuants a) }
+
+  signum a = a { priceQuants = signum (priceQuants a)}
+
+  fromInteger int = Price { priceQuants = giga * fromInteger int} 
+
+  negate a = a { priceQuants = negate (priceQuants a) }
+
+toDouble :: Price -> Double
+toDouble p = fromIntegral (priceQuants p) / fromIntegral giga
+
+fromDouble :: Double -> Price
+fromDouble d = Price { priceQuants = truncate (d * fromIntegral giga) }

src/ATrade/Types.hs

@@ -163,7 +163,7 @@ data Bar = Bar {
   barLow :: !Decimal,
   barClose :: !Decimal,
   barVolume :: !Integer
-} deriving (Show, Eq)
+} deriving (Show, Eq, Generic)
 
 data SignalId = SignalId {
   strategyId :: T.Text,

test/ArbitraryInstances.hs

@@ -11,8 +11,10 @@ import Test.Tasty.QuickCheck as QC
 import Test.QuickCheck.Instances hiding (Text)
 
 import ATrade.Types
+import ATrade.Price as P
 import ATrade.Broker.Protocol
 
+import Data.Int
 import Data.Decimal
 import Data.Scientific
 import Data.Time.Clock
@@ -117,3 +119,5 @@ instance Arbitrary BrokerServerResponse where
        | t == 3 -> ResponseNotifications <$> arbitrary
        | t == 4 -> ResponseError <$> arbitrary
 
+instance Arbitrary P.Price where
+  arbitrary = P.Price <$> arbitrary

test/TestTypes.hs

@@ -11,6 +11,7 @@ import Test.Tasty.QuickCheck as QC
 import Test.Tasty.HUnit
 
 import ATrade.Types
+import ATrade.Price as P
 import ArbitraryInstances
 
 import Data.Aeson
@@ -32,6 +33,8 @@ properties = testGroup "Types" [
   , testOrderStateSerialization
   , testOrderSerialization
   , testTradeSerialization
+  , testPrice1
+  , testPrice2
   ]
 
 testTickSerialization = QC.testProperty "Deserialize serialized tick"
@@ -80,3 +83,12 @@ testTradeSerialization = QC.testProperty "Deserialize serialized Trade"
   (\v -> case (decode . encode $ v :: Maybe Trade) of
     Just s -> s == v
     Nothing -> False)
+
+testPrice1 = QC.testProperty "fromDouble . toDouble $ Price"
+  (\p -> let newp = (P.fromDouble . P.toDouble) p in
+    (abs (priceQuants newp - priceQuants p) < 1000))
+
+testPrice2 = QC.testProperty "toDouble . fromDouble $ Price" $
+  QC.forAll (arbitrary `suchThat` (< 1000000000)) (\d -> let newd = (P.toDouble . P.fromDouble) d in
+    (abs (newd - d) < 0.000001))
+