diff --git a/src/OrderBook/Graph/Build.hs b/src/OrderBook/Graph/Build.hs index 2160643..5a20bc3 100644 --- a/src/OrderBook/Graph/Build.hs +++ b/src/OrderBook/Graph/Build.hs @@ -10,6 +10,7 @@ module OrderBook.Graph.Build , SortedOrders, first, rest, prepend, toList, replaceHead , Tagged(..) , build +, buildFromOrders ) where @@ -68,3 +69,33 @@ create = groupByMarket = groupBy sameBaseQuote . sortOn Util.baseQuote sameBaseQuote :: ABook -> ABook -> Bool sameBaseQuote ob1 ob2 = Util.baseQuote ob1 == Util.baseQuote ob2 + +-- ^ Same as 'build' but take orders (instead of order books) as input. +-- Only present for backwards compatibility (slower than 'build'). +buildFromOrders + :: (PrimMonad m) + => SellOrderGraph (PrimState m) g "arb" -- ^ Empty graph + -> [SomeSellOrder] -- ^ Orders + -> m () +buildFromOrders mGraph orders = do + forM_ (createFromOrders orders) (DG.insertEdge mGraph . Tagged) + +-- | +createFromOrders + :: [SomeSellOrder] -- ^ A bunch of sell orders + -> [SortedOrders] +createFromOrders = + -- TODO: sort order books instead of orders + fmap (SortedOrders . NE.fromList . sortOn soPrice) . groupByMarket + . fmap assertPositivePrice + where + assertPositivePrice order + | soPrice order >= 0 = order + | otherwise = error $ "negative-price order: " ++ show order + groupByMarket = groupBy sameSrcDst . sortBy orderSrcDst + sameSrcDst oA oB = + soBase oA == soBase oB && + soQuote oA == soQuote oB + orderSrcDst oA oB = + soBase oA `compare` soBase oB <> + soQuote oA `compare` soQuote oB diff --git a/test/Common/Util.hs b/test/Common/Util.hs index 7d95197..1f1b1a3 100644 --- a/test/Common/Util.hs +++ b/test/Common/Util.hs @@ -32,7 +32,7 @@ assertMatchedOrders assertMatchedOrders sellOrders buyOrder f = void $ do shuffledSellOrders <- Shuffle.shuffleM sellOrders matchedOrders <- ST.stToIO $ DG.withGraph $ \mGraph -> do - Lib.build mGraph shuffledSellOrders + Lib.buildFromOrders mGraph shuffledSellOrders (buyGraph, _) <- Lib.runArb mGraph $ Lib.arbitrages buyOrder Lib.runMatch buyGraph $ Lib.match buyOrder assertAscendingPriceSorted matchedOrders diff --git a/test/Property/Build.hs b/test/Property/Build.hs index 0b57064..db6abe3 100644 --- a/test/Property/Build.hs +++ b/test/Property/Build.hs @@ -42,7 +42,7 @@ addEdgesCheckOutgoing addEdgesCheckOutgoing orders = do shuffledOrders <- Shuffle.shuffleM orders outgoingEdges <- ST.stToIO $ DG.withGraph $ \graph -> do - Build.build graph shuffledOrders + Build.buildFromOrders graph shuffledOrders foldM (collectOutgoing graph) [] =<< DG.vertices graph let graphOrders = concat $ Build.toList . Build.unTagged <$> concat outgoingEdges sort graphOrders `shouldBe` sort orders