From ce6db1e1d0dd1947c2e8493d2e38f1a8fa6d7c6e Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Sun, 15 Oct 2017 17:51:24 +0700
Subject: [PATCH] New type Price

---
 libatrade.cabal            |  1 +
 src/ATrade/Price.hs        | 37 +++++++++++++++++++++++++++++++++++++
 src/ATrade/Types.hs        |  2 +-
 test/ArbitraryInstances.hs |  4 ++++
 test/TestTypes.hs          | 12 ++++++++++++
 5 files changed, 55 insertions(+), 1 deletion(-)
 create mode 100644 src/ATrade/Price.hs

diff --git a/libatrade.cabal b/libatrade.cabal
index 74c3526..f26203a 100644
--- a/libatrade.cabal
+++ b/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
diff --git a/src/ATrade/Price.hs b/src/ATrade/Price.hs
new file mode 100644
index 0000000..878711b
--- /dev/null
+++ b/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) }
diff --git a/src/ATrade/Types.hs b/src/ATrade/Types.hs
index d33c89f..6397979 100644
--- a/src/ATrade/Types.hs
+++ b/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,
diff --git a/test/ArbitraryInstances.hs b/test/ArbitraryInstances.hs
index 7d3dafb..0e9c7f2 100644
--- a/test/ArbitraryInstances.hs
+++ b/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
diff --git a/test/TestTypes.hs b/test/TestTypes.hs
index b8cbc15..a87f86d 100644
--- a/test/TestTypes.hs
+++ b/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))
+