Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Match: data structures + helpers in separate module
  • Loading branch information
runeksvendsen committed Apr 12, 2019
1 parent b8639d8 commit 113c2e8
Show file tree
Hide file tree
Showing 2 changed files with 83 additions and 70 deletions.
71 changes: 1 addition & 70 deletions src/OrderBook/Graph/Match.hs
Expand Up @@ -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'(..)
)
Expand All @@ -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)
Expand Down
82 changes: 82 additions & 0 deletions 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

0 comments on commit 113c2e8

Please sign in to comment.