From 113c2e8be823a5828a690c81d3aa4b35e610d849 Mon Sep 17 00:00:00 2001 From: "Rune K. Svendsen" Date: Fri, 12 Apr 2019 13:31:35 +0200 Subject: [PATCH] Match: data structures + helpers in separate module --- src/OrderBook/Graph/Match.hs | 71 +------------------------- src/OrderBook/Graph/Match/Types.hs | 82 ++++++++++++++++++++++++++++++ 2 files changed, 83 insertions(+), 70 deletions(-) create mode 100644 src/OrderBook/Graph/Match/Types.hs diff --git a/src/OrderBook/Graph/Match.hs b/src/OrderBook/Graph/Match.hs index 14e168e..3cb787e 100644 --- a/src/OrderBook/Graph/Match.hs +++ b/src/OrderBook/Graph/Match.hs @@ -15,6 +15,7 @@ module OrderBook.Graph.Match where import OrderBook.Graph.Internal.Prelude +import OrderBook.Graph.Match.Types import OrderBook.Graph.Build ( SomeSellOrder , SomeSellOrder'(..) ) @@ -28,76 +29,6 @@ import qualified Data.Text as T import Unsafe.Coerce (unsafeCoerce) --- | -data BuyOrder' numTyp (dst :: Symbol) (src :: Symbol) = BuyOrder' - { boQuantity :: Maybe numTyp - , boMaxPrice :: Maybe numTyp - -- ^ (TODO: IGNORED FOR NOW) maximum price - , boMaxSlippage :: Maybe numTyp - -- ^ maximum percentage difference - -- between price of first and last matched order - } - -type BuyOrder = BuyOrder' Rational - --- | A buy order whose execution will continue until there --- is no path from 'src' to 'dst'. -unlimited - :: Fractional numTyp - => BuyOrder' numTyp dst src -unlimited = BuyOrder' - { boQuantity = Nothing - , boMaxPrice = Nothing - , boMaxSlippage = Nothing - } - -type MatchResult = MatchResult' Rational - --- | Result of executing a 'BuyOrder' -data MatchResult' numTyp = MatchResult' - { mrOrders :: [SomeSellOrder' numTyp] -- ^ Matched orders - , mrFirstOrder :: Maybe (SomeSellOrder' numTyp) -- ^ First matched order - , mrQuantity :: numTyp -- ^ Matched quantity - } deriving (Eq, Show) - -empty :: Num numTyp => MatchResult' numTyp -empty = MatchResult' - { mrOrders = [] - , mrFirstOrder = Nothing - , mrQuantity = 0 - } - -addOrder - :: (Real numTyp, Show numTyp) - => MatchResult' numTyp - -> SomeSellOrder' numTyp - -> MatchResult' numTyp -addOrder (MatchResult' [] Nothing _) order = - MatchResult' [order] (Just order) (soQty order) -addOrder (MatchResult' orders firstOrder@Just{} qty) order = - MatchResult' (order : orders) firstOrder (qty + soQty order) -addOrder mr@(MatchResult' _ Nothing _) _ = - error $ "invalid MatchResult' " ++ show mr - --- | Stop order execution if this returns 'True' --- --- TODO: check maximum price -orderFilled - :: (Fractional numTyp, Real numTyp, Show numTyp) - => BuyOrder' numTyp base quote - -> MatchResult' numTyp - -> Bool -orderFilled _ (MatchResult' _ Nothing _) = False -orderFilled _ mr@(MatchResult' [] Just{} _) = error $ "invalid MatchResult' " ++ show mr -orderFilled (BuyOrder' qtyM _ slipM) (MatchResult' (latest:_) (Just first) mrQty) = - qtyFilled || slippageReached - where - checkProp propM f = maybe False f propM - qtyFilled = checkProp qtyM $ \qty -> mrQty >= qty - slippageReached = checkProp slipM $ \maxSlippage -> - let slippagePct = (soPrice latest - soPrice first) / soPrice first * 100 - in slippagePct > maxSlippage - match :: forall s g base quote. (KnownSymbol base, KnownSymbol quote) diff --git a/src/OrderBook/Graph/Match/Types.hs b/src/OrderBook/Graph/Match/Types.hs new file mode 100644 index 0000000..660ca65 --- /dev/null +++ b/src/OrderBook/Graph/Match/Types.hs @@ -0,0 +1,82 @@ +module OrderBook.Graph.Match.Types +( BuyOrder +, BuyOrder'(..) +, unlimited +, MatchResult +, MatchResult'(..) +, empty +, addOrder +, orderFilled +) +where + +import OrderBook.Graph.Internal.Prelude +import OrderBook.Graph.Build (SomeSellOrder'(..)) + + +-- | +data BuyOrder' numTyp (dst :: Symbol) (src :: Symbol) = BuyOrder' + { boQuantity :: Maybe numTyp + , boMaxPrice :: Maybe numTyp + -- ^ (TODO: IGNORED FOR NOW) maximum price + , boMaxSlippage :: Maybe numTyp + -- ^ maximum percentage difference between price of first and last matched order + } + +type BuyOrder = BuyOrder' Rational + +-- | A buy order whose execution will continue until there +-- is no path from 'src' to 'dst'. +unlimited + :: Fractional numTyp + => BuyOrder' numTyp dst src +unlimited = BuyOrder' + { boQuantity = Nothing + , boMaxPrice = Nothing + , boMaxSlippage = Nothing + } + +type MatchResult = MatchResult' Rational +data MatchResult' numTyp = MatchResult' + { mrOrders :: [SomeSellOrder' numTyp] + , mrFirstOrder :: Maybe (SomeSellOrder' numTyp) + , mrQuantity :: numTyp + } deriving (Eq, Show) + +empty :: Num numTyp => MatchResult' numTyp +empty = MatchResult' + { mrOrders = [] + , mrFirstOrder = Nothing + , mrQuantity = 0 + } + +addOrder + :: (Real numTyp, Show numTyp) + => MatchResult' numTyp + -> SomeSellOrder' numTyp + -> MatchResult' numTyp +addOrder (MatchResult' [] Nothing _) order = + MatchResult' [order] (Just order) (soQty order) +addOrder (MatchResult' orders firstOrder@Just{} qty) order = + MatchResult' (order : orders) firstOrder (qty + soQty order) +addOrder mr@(MatchResult' _ Nothing _) _ = + error $ "invalid MatchResult' " ++ show mr + +-- | Stop order execution if this returns 'True' +-- +-- TODO: check maximum price +orderFilled + :: (Fractional numTyp, Real numTyp, Show numTyp) + => BuyOrder' numTyp base quote + -> MatchResult' numTyp + -> Bool +orderFilled _ (MatchResult' _ Nothing _) = False +orderFilled _ mr@(MatchResult' [] Just{} _) = error $ "invalid MatchResult' " ++ show mr +orderFilled (BuyOrder' qtyM _ slipM) (MatchResult' (latest:_) (Just first) mrQty) = + qtyFilled || slippageReached + where + checkProp propM f = maybe False f propM + qtyFilled = checkProp qtyM $ \qty -> mrQty >= qty + slippageReached = checkProp slipM $ \maxSlippage -> + let slippagePct = (soPrice latest - soPrice first) / soPrice first * 100 + in slippagePct > maxSlippage