patternMinor
Using monads and monad transformers (simple matching engine)
Viewed 0 times
transformersenginesimplemonadsusingandmatchingmonad
Problem
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)
| ot
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)
| ot
Solution
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
It does away with the partial
Here is the
```
{-# 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
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
Code Snippets
{-# 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){-# 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
Context
StackExchange Code Review Q#141448, answer score: 3
Revisions (0)
No revisions yet.