# Using monads and monad transformers (simple matching engine)

Like most of the folks here, I'm learning Haskell, so I figured an interesting exercise would be to build a matching engine that I could use to build a financial exchange. I'm wondering primarily if I used monad transformers here idiomatically, but all other feedback is appreciated as well.

In some cases I felt like using the monad was overkill and maybe I should have just carried the state or log of trades along in the arguments to the various functions, for clarity. Also, this would have to be embedded into other monads and then eventually of course an IO monad in order to be able to receive orders from the network, check people's accounts, etc.

It seems like using the (MonadX) => constraint was the right way to go so that my function signatures only needed to mention the specific monad I needed rather than the entire stack of transformers, but I'm not sure.

Order.hs:

module Order where
import Numeric.Natural

-- | 'Side' defines if an order is a buy or sell
data Side = Buy | Sell deriving (Eq, Show)

-- | 'Order' represents the core details of a given order
data Order = Order { side :: Side, price :: Natural, quantity :: Natural, timestamp :: Natural } deriving Show

-- | 'OrderId' is a reference used externally to refer to a certain order, which may have changed
type OrderId = Int

-- | 'Eq' for 'Order' doesn't care if the quantities are different
instance Eq Order where
(==) x y = (side x == side y) && (price x == price y) && (timestamp x == timestamp y)

-- | 'Ord' for 'Order' is a price-time ordering, which inverts the price ordering if it is a Buy
-- | so that the best bid and ask are always 'least'. For orders of the same price, the earliest
-- | one is better.
instance Ord Order where
compare x y
| x == y = EQ
| side x /= side y = error "Can't compare orders of different sides"
| priceCompare == EQ   = compare (timestamp x) (timestamp y)
| otherwise            = priceCompare
where
priceModifier = case side x of
Buy -> flip
Sell -> id
priceCompare = priceModifier compare (price x) (price y)

-- | 'matchCompare' returns True if the two orders can trade against each other. I.e. they are 'matched'
matchCompare :: Order -> Order -> Bool
matchCompare x y
| side x == side y = False
| otherwise = let buyOrder = if side x == Buy then x else y
sellOrder = if side x == Sell then x else y
in price buyOrder >= price sellOrder


OrderBook.hs:

{-# LANGUAGE FlexibleContexts #-}

module OrderBook where
import Data.PSQueue
import Order
import Control.Monad.State
import Control.Monad.Writer
import Numeric.Natural

-- | 'OrderBook' is the representation of the OrderBook
data OrderBook = OrderBook { bids :: PSQ OrderId Order, asks :: PSQ OrderId Order } deriving Show

-- | 'Trade' records the details of a given trade. We're assuming the Orders are stored somewhere by OrderId somewhere
data Trade = Trade { aggressiveOrderId :: OrderId, passiveOrderId :: OrderId, size :: Natural, price :: Natural } deriving (Show, Eq)

emptyBook :: OrderBook
emptyBook = OrderBook empty empty

-- | 'processOrders' is the core that takes orders, matches them, spits out trades and keeps
-- | track of the orderbook.
processOrders :: (MonadState OrderBook m, MonadWriter [Trade] m)  -- ^ We keep track of the orderbook and spit out the list of trades
=> [(OrderId, Order)]                               -- ^ list of orders to put into the book
-> m ()                                             -- ^ no return value, interesting info is in the monads
processOrders [] = return ()
processOrders ((orderId, order):orders) = do
matchResult <- matchOrder (orderId, order)
case matchResult of
Just newOrder -> processOrders ((orderId, newOrder):orders)
Nothing -> processOrders orders
where
-- | 'matchOrder' will create one trade for a given aggressive order (not yet in the book), and spit out what is left of that order
matchOrder :: (MonadState OrderBook m, MonadWriter [Trade] m) -- ^ We keep track of the orderbook and spit out the list of trades
=> (OrderId, Order)                                -- ^ The aggressive order
-> m (Maybe Order)                                 -- ^ Whatever is left of the aggressive order
matchOrder (aggressiveOrderId, aggressiveOrder) =
getMatchingPassive >>= \maybeMatchingPassive ->
case maybeMatchingPassive of
Just (passiveOrderId, passiveOrder) ->
-- a trade happened. Add it to the trade log, update the passive order in the book
-- and return whatever is left over of the aggressive order
let
tradeSize = min (quantity aggressiveOrder) (quantity passiveOrder)
tradePrice = Order.price passiveOrder
newAggressiveOrder = aggressiveOrder { quantity = quantity aggressiveOrder - tradeSize }
newPassiveOrder = passiveOrder { quantity = quantity passiveOrder - tradeSize }
trade = Trade aggressiveOrderId passiveOrderId tradeSize tradePrice
in do
tell [trade]
updateOrder (passiveOrderId, newPassiveOrder)
return $clearOrder newAggressiveOrder Nothing -> do -- no trade happened, so just put the aggressive order into the book. insertOrder (aggressiveOrderId, aggressiveOrder) return Nothing where -- | 'getMatchingPassive' grabs the matching passive order from the other side of the book -- | if one exists. getMatchingPassive :: (MonadState OrderBook m) -- ^ We need to get the book from the state monad => m (Maybe (OrderId, Order)) -- ^ But the maybe this returns isn't used in monadic fashion getMatchingPassive = get >>= \book -> let passiveSide = case side aggressiveOrder of Buy -> asks book Sell -> bids book in case findMin passiveSide of Just (passiveOrderId :-> passiveOrder) -> if matchCompare passiveOrder aggressiveOrder then return$ Just (passiveOrderId, passiveOrder)
else return Nothing
Nothing ->
return Nothing

-- | 'insertOrder' puts an order into the book, but doesn't worry about matching. We must be sure it doesn't match
-- | when we call this... otherwise, problems.
insertOrder :: (MonadState OrderBook m)  -- ^ Keep track of the orderbook
=> (OrderId, Order)          -- ^ The order to insert
-> m ()                      -- ^ The resulting book is in the monad, hence no return value
insertOrder (orderId, order) =
get >>= \book -> case side order of
Buy  -> put $book { bids = insert orderId order (bids book) } Sell -> put$ book { asks = insert orderId order (asks book) }

-- | 'updateOrder' modifies the passive order in the book once a piece has been taken out of it
-- | buy an aggressive order
updateOrder :: (MonadState OrderBook m)  -- ^ Keeping track of the OrderBook
=> (OrderId, Order)          -- ^ The modified order with id
-> m ()                      -- ^ no return value, everything interesting is in the State
updateOrder (orderId, order) =
get >>= \book -> case side order of
Buy  -> put $book { bids = update (const$ clearOrder order) orderId (bids book) }
Sell -> put $book { asks = update (const$ clearOrder order) orderId (asks book) }

-- | 'clearOrder' turns an order with zero size into 'Nothing'
clearOrder :: Order -> Maybe Order
clearOrder order
| quantity order == 0 = Nothing
| otherwise = Just order


## 1 Answer

First of all, I would suggest using phantom types to track the side of an order. The following implementation is over-engineered using type families, but as you seemed to want a fancy solution, you might like it!

The Order.hs file:

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
module Order where

import Numeric.Natural
import Control.Lens

-- | 'Side' defines if an order is a buy or sell
data Buy
data Sell

type family OtherSide a where
OtherSide Buy  = Sell
OtherSide Sell = Buy

-- | 'Order' represents the core details of a given order
data Order side = Order { _price     :: Natural
, _quantity  :: Natural
, _timestamp :: Natural
} deriving (Show, Eq, Ord)

makeLenses ''Order

class ToPriority a where
toPriority :: Order a -> OrderPriority

class MatchCompare side where
matchCompare :: Order side -> Order (OtherSide side) -> Bool

instance ToPriority Buy where
toPriority (Order p _ t) = OrderPriority (negate (fromIntegral p)) t
instance ToPriority Sell where
toPriority (Order p _ t) = OrderPriority (fromIntegral p) t

instance MatchCompare Buy where
matchCompare x y = _price x >= _price y
instance MatchCompare Sell where
matchCompare x y = _price x <= _price y

data OrderPriority = OrderPriority { cprice     :: Integer
, ctimestamp :: Natural
} deriving (Show, Eq, Ord)

type OrderId = Int

data GOrder = OBuy (Order Buy)
| OSell (Order Sell)
deriving (Show, Eq)


It does away with the partial Ord instance, and introduces a new type that represents an order priority. I had to introduce several typeclasses to write generic "business logic". It would probably be much cleaner to fuse the MatchCompare and ToPriority classes into a single class as they are instantiated over the same types.

Here is the OrderBook.hs file:

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}

module OrderBook where
import Data.PSQueue
import Order
import Control.Monad.Writer
import Numeric.Natural
import Control.Lens

-- | 'OrderBook' is the representation of the OrderBook. The queues are ordered by OrderPriority
data OrderBook = OrderBook { _bids :: PSQ (OrderId, Order Buy) OrderPriority
, _asks :: PSQ (OrderId, Order Sell) OrderPriority
} deriving Show

-- The lenses are useful for writing the generic processOrder' function
makeLenses ''OrderBook

data Trade = Trade { aggressiveOrderId :: OrderId
, passiveOrderId    :: OrderId
, size              :: Natural
, price             :: Natural
} deriving (Show, Eq)

emptyBook :: OrderBook
emptyBook = OrderBook empty empty

-- processOrders just folds over individual orders
processOrders :: (MonadWriter [Trade] m)
=> OrderBook
-> [(OrderId, GOrder)]
-> m OrderBook
processOrders = foldM processOrder

-- processOrder just dispatchs the handling of the individual orders to processOrder', depending on their side.
processOrder :: MonadWriter [Trade] m => OrderBook -> (OrderId, GOrder) -> m OrderBook
processOrder book (orderid, gorder) =
case gorder of
OSell o -> processOrder' book asks bids orderid o
OBuy o  -> processOrder' book bids asks orderid o

-- This is one scary type! There are a lot of constraints to the type family and type classes defined in Order.hs
processOrder' :: ( OtherSide passive ~ active
, OtherSide active ~ passive
, MatchCompare active
, MonadWriter [Trade] m
, ToPriority active
, ToPriority passive
)
=> OrderBook
-> Lens' OrderBook (PSQ (OrderId, Order passive) OrderPriority) -- ^ This is the lens that is used to access the "passive" queue, that is the queue that is of the same type as the order
-> Lens' OrderBook (PSQ (OrderId, Order active) OrderPriority) -- ^ This is the lens that is used to access the "active" queue
-> OrderId
-> Order passive -- ^ The order to process
-> m OrderBook
processOrder' book lactive lpassive aOrderId aOrder =
-- First of all, check if something is waiting for us in the passive queue
case getMatchingPassive (book ^. lpassive) aOrder of
Nothing -> return \$ book & lactive %~ insert (aOrderId, aOrder) (toPriority aOrder) -- nothing, queue the order
Just (pOrderId, pOrder, passiveQueueView) ->
let tradeSize = min (_quantity aOrder) (_quantity pOrder)
tradePrice = Order._price pOrder
nAOrder = aOrder & quantity -~ tradeSize
nPOrder = pOrder & quantity -~ tradeSize
-- if the passive order is "emptied", we can just drop it, otherwise the queue needs to be updated
nPassiveQueue = if nPOrder ^. quantity == 0
then passiveQueueView
else insert (pOrderId, nPOrder) (toPriority nPOrder) passiveQueueView
nbook = book & lpassive .~ nPassiveQueue
in  do
tell [Trade aOrderId pOrderId tradeSize tradePrice]
-- if the active order is not "emptied", it needs to be updated and processed again
if nAOrder ^. quantity == 0
then return nbook
else processOrder' nbook lactive lpassive aOrderId nAOrder

-- This checks if there is something waiting in the queue, and returns the minView if there is
getMatchingPassive :: MatchCompare side
=> PSQ (OrderId, Order side) OrderPriority
-> Order (OtherSide side)
-> Maybe (OrderId, Order side, PSQ (OrderId, Order side) OrderPriority)
getMatchingPassive queue aOrder =
minView queue >>= \((pOrderId, pOrder) :-> _, nq) ->
if matchCompare pOrder aOrder
then Just (pOrderId, pOrder, nq)
else Nothing


I chose to do away with the State monad, but decided to keep the Writer, as it seemed cumbersome to handle it otherwise.

Hopefully I didn't mangle the logic!

• Thanks these are great suggestions! I'll incorporate them. Question about this "Also it is quite bad to have unlawful (or partial) instances for Ord and Eq! Why not use your queues that way?" Is the "unlawful" bit the fact that 'Eq' doesn't care about quantity? Those instances aren't partial, right? they implement the minimum required as far as I can tell. – Sameer Parekh Brenn Sep 17 '16 at 20:05
• Actually-- question. matchCompare actually needs to compare two different sides. Ie it compares a buy with a sell. It doesn't compare two buys or two sells. Looks like your implementation compares two buys or two sells. Can I use phantom types to make matchCompare do what I want? – Sameer Parekh Brenn Sep 17 '16 at 20:11
• I am sorry that I didn't really take the time to understand your code! If compareMatch compares two sides, then I think its type should reflect this and that it should be a plain function. – bartavelle Sep 18 '16 at 8:09
• Also the note about the unlawful instances was mainly about the fact that you could have a /= b and compare a b == EQ! – bartavelle Sep 18 '16 at 8:17
• Actually I don't think you could have such a case! My bad. – bartavelle Sep 18 '16 at 8:43