From ce2408c1d1041795cfebeb6467315a79470b3d3e Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Mon, 6 Dec 2021 12:38:32 +0700
Subject: [PATCH] Order matching: mostly works

---
 src/ATrade/ESim/Core.hs | 56 +++++++++++++++++++++++++++++++++--------
 test/TestLOB.hs         |  3 ++-
 2 files changed, 47 insertions(+), 12 deletions(-)

diff --git a/src/ATrade/ESim/Core.hs b/src/ATrade/ESim/Core.hs
index e3f79f8..5dcf5fc 100644
--- a/src/ATrade/ESim/Core.hs
+++ b/src/ATrade/ESim/Core.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PatternSynonyms            #-}
+
 module ATrade.ESim.Core (
   addToLob,
   LimitOrderBook,
@@ -12,18 +15,19 @@ import ATrade.Price    (decompose)
 import ATrade.Types
     (Operation (Buy, Sell), Order (orderId, orderOperation, orderPrice, orderQuantity), OrderId,
     OrderPrice (Limit, Market), Price, TickerId)
+import Control.Monad   (foldM)
 import Data.Map.Strict qualified as M
 import Data.Maybe      (fromMaybe)
-import Data.Sequence   (Seq, empty, (|>))
+import Data.Sequence   (Seq (Empty, (:<|)), empty, (|>))
 
 -- | Represents price in tick size units
 newtype PriceTick
   = PriceTick { unPriceTick :: Int }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Num, Ord, Show)
 
 newtype Volume
   = Volume { unVolume :: Int }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Num, Ord, Show)
 
 data LimitOrderBook
   = LimitOrderBook
@@ -51,9 +55,9 @@ addToLob order lob = fromMaybe [Reject order] (addToLob' order lob)
       then Just (PriceTick . fromIntegral . truncatePrice $ price / lobTickSize lob)
       else Nothing
     addToLob' order lob = case (orderPrice order, maybeStartPrice) of
-      (Market, Just startPrice)      -> addToLobMarket (orderQuantity order) lob startPrice
+      (Market, Just startPrice)      -> addToLobMarket (fromInteger $ orderQuantity order) lob startPrice
       (Market, Nothing)              -> Nothing
-      (Limit price, Just startPrice) -> maybePriceTick price >>= addToLobLimit (orderQuantity order) lob startPrice
+      (Limit price, Just startPrice) -> maybePriceTick price >>= addToLobLimit (fromInteger $ orderQuantity order) lob startPrice
       (Limit price, Nothing)         -> maybePriceTick price >>= (\priceTick ->
                                           Just [Enqueue (orderId order) priceTick (Volume . fromIntegral $ orderQuantity order) (orderOperation order)])
       _                              -> error "Not implemented"
@@ -62,17 +66,47 @@ addToLob order lob = fromMaybe [Reject order] (addToLob' order lob)
       Buy  -> M.lookupMin lobPart
       Sell -> M.lookupMax lobPart
 
-    (lobPart, lookupFun) = if orderOperation order == Buy
-                then (lobOffers lob, M.lookupLE)
-                else (lobBids lob, M.lookupGE)
+    (lobPart, lookupFun, priceStepFun) = if orderOperation order == Buy
+                then (lobOffers lob, M.lookupLE, (+ 1))
+                else (lobBids lob, M.lookupGE, \x -> x - 1)
 
     addToLobMarket left lob currentPrice = if left == 0
       then Just []
       else case lookupFun currentPrice lobPart of
-        Just sq -> undefined
-        Nothing -> undefined
+        Just (k, v) ->
+          let (matched, result) = matchSequence v left currentPrice in
+            case addToLobMarket (left - matched) lob (priceStepFun currentPrice) of
+              Just rest -> Just (result ++ rest)
+              Nothing   -> Nothing
+        Nothing     -> Nothing
+
+    addToLobLimit left lob currentPrice priceTick = if left == 0
+      then Just []
+      else case lookupFun currentPrice lobPart of
+        Just (k, v) ->
+          let (matched, result) = matchSequence v left currentPrice in
+            case addToLobLimit (left - matched) lob (priceStepFun currentPrice) priceTick of
+              Just rest -> Just (result ++ rest)
+              Nothing   -> Nothing
+        Nothing     -> Just [Enqueue (orderId order) priceTick (Volume left) (orderOperation order)]
 
-    addToLobLimit left lob currentPrice priceTick = undefined
+
+    matchSequence ((oid, Volume volume) :<| rest) left priceTick = if left > 0
+      then
+        if volume <= left
+        then let (matched, result) = matchSequence rest (left - volume) priceTick in
+          (matched + volume, Match (orderId order) oid (orderOperation order) priceTick (Volume volume) : result)
+        else (left, [Match (orderId order) oid (orderOperation order) priceTick (Volume left)])
+      else (0, [])
+    matchSequence Empty left priceTick = (0, [])
+
+
+    match priceTick (left, xs) (oid, Volume volume) = if left > 0
+      then
+        if volume <= left
+        then Just (left - volume, Match (orderId order) oid (orderOperation order) priceTick (Volume volume) : xs)
+        else Just (0, Match (orderId order) oid (orderOperation order) priceTick (Volume left) : xs)
+      else Nothing
 
 emptyLob :: TickerId -> Price -> LimitOrderBook
 emptyLob tid tickSize = LimitOrderBook tickSize M.empty M.empty tid M.empty
diff --git a/test/TestLOB.hs b/test/TestLOB.hs
index 9713fa4..27b159e 100644
--- a/test/TestLOB.hs
+++ b/test/TestLOB.hs
@@ -52,8 +52,9 @@ prop_full_match = property $ do
             <*> pure Buy
             <*> pure Unsubmitted
             <*> pure (SignalId "test" "foo" "")
-  addToLob order (lob order priceTick) === [Match 1 (orderId order) Sell (PriceTick priceTick) (Volume . fromIntegral $ orderQuantity order)]
+  addToLob order (lob order priceTick) === [Match (orderId order) 1 (orderOperation order) (PriceTick priceTick) (Volume . fromIntegral $ orderQuantity order)]
   where
     lob order priceTick = executeMatchingActions lob0 [Enqueue 1 (PriceTick priceTick) (Volume . fromIntegral $ orderQuantity order) Sell]
     lob0 = emptyLob "Test" tickSize
     tickSize = 0.1
+