6
\$\begingroup\$

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
\$\endgroup\$

1 Answer 1

3
\$\begingroup\$

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!

\$\endgroup\$
6
  • \$\begingroup\$ 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. \$\endgroup\$ Sep 17, 2016 at 20:05
  • \$\begingroup\$ 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? \$\endgroup\$ Sep 17, 2016 at 20:11
  • \$\begingroup\$ 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. \$\endgroup\$
    – bartavelle
    Sep 18, 2016 at 8:09
  • \$\begingroup\$ Also the note about the unlawful instances was mainly about the fact that you could have a /= b and compare a b == EQ! \$\endgroup\$
    – bartavelle
    Sep 18, 2016 at 8:17
  • \$\begingroup\$ Actually I don't think you could have such a case! My bad. \$\endgroup\$
    – bartavelle
    Sep 18, 2016 at 8:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.