summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/MinMaxPSQ.hs24
-rw-r--r--src/Network/BitTorrent/DHT/Search.hs13
2 files changed, 20 insertions, 17 deletions
diff --git a/src/Data/MinMaxPSQ.hs b/src/Data/MinMaxPSQ.hs
index 96937604..f41da4a4 100644
--- a/src/Data/MinMaxPSQ.hs
+++ b/src/Data/MinMaxPSQ.hs
@@ -17,48 +17,48 @@ null (MinMaxPSQ nq xq) = PSQ.null nq
17size :: MinMaxPSQ k p -> Int 17size :: MinMaxPSQ k p -> Int
18size (MinMaxPSQ nq xq) = PSQ.size nq 18size (MinMaxPSQ nq xq) = PSQ.size nq
19 19
20toList :: (Ord k, Ord p) => MinMaxPSQ k p -> [Binding k p] 20toList :: (PSQKey k, Ord p) => MinMaxPSQ k p -> [Binding k p]
21toList (MinMaxPSQ nq xq) = PSQ.toList nq 21toList (MinMaxPSQ nq xq) = PSQ.toList nq
22 22
23fromList :: (Ord k, Ord p) => [Binding k p] -> MinMaxPSQ k p 23fromList :: (PSQKey k, Ord p) => [Binding k p] -> MinMaxPSQ k p
24fromList kps = MinMaxPSQ (PSQ.fromList kps) 24fromList kps = MinMaxPSQ (PSQ.fromList kps)
25 (PSQ.fromList $ map (\(k :-> p) -> (k :-> Down p)) kps) 25 (PSQ.fromList $ map (\(k :-> p) -> (k :-> Down p)) kps)
26 26
27findMin :: (Ord k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) 27findMin :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p)
28findMin (MinMaxPSQ nq xq) = PSQ.findMin nq 28findMin (MinMaxPSQ nq xq) = PSQ.findMin nq
29 29
30findMax :: (Ord k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) 30findMax :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p)
31findMax (MinMaxPSQ nq xq) = fmap (\(k :-> Down p) -> k :-> p) $ PSQ.findMin xq 31findMax (MinMaxPSQ nq xq) = fmap (\(k :-> Down p) -> k :-> p) $ PSQ.findMin xq
32 32
33insert :: (Ord k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p 33insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p
34insert k p (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.insert k p nq) 34insert k p (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.insert k p nq)
35 (PSQ.insert k (Down p) xq) 35 (PSQ.insert k (Down p) xq)
36 36
37delete :: (Ord k, Ord p) => k -> MinMaxPSQ k p -> MinMaxPSQ k p 37delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ k p -> MinMaxPSQ k p
38delete k (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.delete k nq) (PSQ.delete k xq) 38delete k (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.delete k nq) (PSQ.delete k xq)
39 39
40deleteMin :: (Ord k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p 40deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p
41deleteMin (MinMaxPSQ nq xq) = case PSQ.minView nq of 41deleteMin (MinMaxPSQ nq xq) = case PSQ.minView nq of
42 Just (k :-> _, nq') -> MinMaxPSQ nq' (PSQ.delete k xq) 42 Just (k :-> _, nq') -> MinMaxPSQ nq' (PSQ.delete k xq)
43 Nothing -> MinMaxPSQ nq xq 43 Nothing -> MinMaxPSQ nq xq
44 44
45deleteMax :: (Ord k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p 45deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p
46deleteMax (MinMaxPSQ nq xq) = case PSQ.minView xq of 46deleteMax (MinMaxPSQ nq xq) = case PSQ.minView xq of
47 Just (k :-> _, xq') -> MinMaxPSQ (PSQ.delete k nq) xq' 47 Just (k :-> _, xq') -> MinMaxPSQ (PSQ.delete k nq) xq'
48 Nothing -> MinMaxPSQ nq xq 48 Nothing -> MinMaxPSQ nq xq
49 49
50minView :: (Ord k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) 50minView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p)
51minView (MinMaxPSQ nq xq) = fmap (\(k :-> p, nq') -> (k :-> p, MinMaxPSQ nq' (PSQ.delete k xq))) 51minView (MinMaxPSQ nq xq) = fmap (\(k :-> p, nq') -> (k :-> p, MinMaxPSQ nq' (PSQ.delete k xq)))
52 $ PSQ.minView nq 52 $ PSQ.minView nq
53 53
54maxView :: (Ord k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) 54maxView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p)
55maxView (MinMaxPSQ nq xq) = fmap (\(k :-> Down p, xq') -> (k :-> p, MinMaxPSQ (PSQ.delete k nq) xq')) 55maxView (MinMaxPSQ nq xq) = fmap (\(k :-> Down p, xq') -> (k :-> p, MinMaxPSQ (PSQ.delete k nq) xq'))
56 $ PSQ.minView xq 56 $ PSQ.minView xq
57 57
58insertTake :: (Ord k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p 58insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p
59insertTake n k p q = take n $ insert k p q 59insertTake n k p q = take n $ insert k p q
60 60
61take :: (Ord k, Ord p) => Int -> MinMaxPSQ k p -> MinMaxPSQ k p 61take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ k p -> MinMaxPSQ k p
62take !n !q | (size q <= n) = q 62take !n !q | (size q <= n) = q
63 | null q = q 63 | null q = q
64 | otherwise = take n $ deleteMax q 64 | otherwise = take n $ deleteMax q
diff --git a/src/Network/BitTorrent/DHT/Search.hs b/src/Network/BitTorrent/DHT/Search.hs
index 356f6fd9..07240755 100644
--- a/src/Network/BitTorrent/DHT/Search.hs
+++ b/src/Network/BitTorrent/DHT/Search.hs
@@ -23,7 +23,7 @@ import System.IO
23import qualified Data.MinMaxPSQ as MM 23import qualified Data.MinMaxPSQ as MM
24 ;import Data.MinMaxPSQ (MinMaxPSQ) 24 ;import Data.MinMaxPSQ (MinMaxPSQ)
25import qualified Data.Wrapper.PSQ as PSQ 25import qualified Data.Wrapper.PSQ as PSQ
26 ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ) 26 ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ, PSQKey)
27import Network.Address hiding (NodeId) 27import Network.Address hiding (NodeId)
28import Network.DatagramServer.Types 28import Network.DatagramServer.Types
29import Data.Bits 29import Data.Bits
@@ -39,7 +39,8 @@ data IterativeSearch dht u ip r = IterativeSearch
39 } 39 }
40 40
41newSearch :: ( Eq ip 41newSearch :: ( Eq ip
42 , Ord (NodeId dht) 42 , PSQKey (NodeId dht)
43 , PSQKey (NodeInfo dht ip u)
43 , FiniteBits (NodeId dht) 44 , FiniteBits (NodeId dht)
44 ) => (NodeInfo dht ip u -> IO ([NodeInfo dht ip u], [r])) 45 ) => (NodeInfo dht ip u -> IO ([NodeInfo dht ip u], [r]))
45 -> NodeId dht -> [NodeInfo dht ip u] -> IO (IterativeSearch dht u ip r) 46 -> NodeId dht -> [NodeInfo dht ip u] -> IO (IterativeSearch dht u ip r)
@@ -60,7 +61,8 @@ searchK = 8
60sendQuery :: forall a ip dht u. 61sendQuery :: forall a ip dht u.
61 ( Ord a 62 ( Ord a
62 , Ord ip 63 , Ord ip
63 , Ord (NodeId dht) 64 , PSQKey (NodeId dht)
65 , PSQKey (NodeInfo dht ip u)
64 , FiniteBits (NodeId dht) 66 , FiniteBits (NodeId dht)
65 ) => 67 ) =>
66 IterativeSearch dht u ip a 68 IterativeSearch dht u ip a
@@ -85,7 +87,8 @@ sendQuery IterativeSearch{..} (ni :-> d) = do
85 87
86 88
87searchIsFinished :: ( Ord ip 89searchIsFinished :: ( Ord ip
88 , Ord (NodeId dht) 90 , PSQKey (NodeId dht)
91 , PSQKey (NodeInfo dht ip u)
89 ) => IterativeSearch dht u ip r -> STM Bool 92 ) => IterativeSearch dht u ip r -> STM Bool
90searchIsFinished IterativeSearch{..} = do 93searchIsFinished IterativeSearch{..} = do
91 q <- readTVar searchQueued 94 q <- readTVar searchQueued
@@ -98,7 +101,7 @@ searchIsFinished IterativeSearch{..} = do
98 <= PSQ.prio (fromJust $ MM.findMin q)))) 101 <= PSQ.prio (fromJust $ MM.findMin q))))
99 102
100search :: 103search ::
101 (Ord r, Ord ip, Ord (NodeId dht), FiniteBits (NodeId dht)) => 104 (Ord r, Ord ip, PSQKey (NodeId dht), PSQKey (NodeInfo dht ip u), FiniteBits (NodeId dht)) =>
102 IterativeSearch dht u ip r -> IO () 105 IterativeSearch dht u ip r -> IO ()
103search s@IterativeSearch{..} = withTaskGroup searchAlpha $ \g -> do 106search s@IterativeSearch{..} = withTaskGroup searchAlpha $ \g -> do
104 fix $ \again -> do 107 fix $ \again -> do