diff options
-rw-r--r-- | src/Data/MinMaxPSQ.hs | 24 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Search.hs | 13 |
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 | |||
17 | size :: MinMaxPSQ k p -> Int | 17 | size :: MinMaxPSQ k p -> Int |
18 | size (MinMaxPSQ nq xq) = PSQ.size nq | 18 | size (MinMaxPSQ nq xq) = PSQ.size nq |
19 | 19 | ||
20 | toList :: (Ord k, Ord p) => MinMaxPSQ k p -> [Binding k p] | 20 | toList :: (PSQKey k, Ord p) => MinMaxPSQ k p -> [Binding k p] |
21 | toList (MinMaxPSQ nq xq) = PSQ.toList nq | 21 | toList (MinMaxPSQ nq xq) = PSQ.toList nq |
22 | 22 | ||
23 | fromList :: (Ord k, Ord p) => [Binding k p] -> MinMaxPSQ k p | 23 | fromList :: (PSQKey k, Ord p) => [Binding k p] -> MinMaxPSQ k p |
24 | fromList kps = MinMaxPSQ (PSQ.fromList kps) | 24 | fromList 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 | ||
27 | findMin :: (Ord k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) | 27 | findMin :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) |
28 | findMin (MinMaxPSQ nq xq) = PSQ.findMin nq | 28 | findMin (MinMaxPSQ nq xq) = PSQ.findMin nq |
29 | 29 | ||
30 | findMax :: (Ord k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) | 30 | findMax :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p) |
31 | findMax (MinMaxPSQ nq xq) = fmap (\(k :-> Down p) -> k :-> p) $ PSQ.findMin xq | 31 | findMax (MinMaxPSQ nq xq) = fmap (\(k :-> Down p) -> k :-> p) $ PSQ.findMin xq |
32 | 32 | ||
33 | insert :: (Ord k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p | 33 | insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p |
34 | insert k p (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.insert k p nq) | 34 | insert 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 | ||
37 | delete :: (Ord k, Ord p) => k -> MinMaxPSQ k p -> MinMaxPSQ k p | 37 | delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ k p -> MinMaxPSQ k p |
38 | delete k (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.delete k nq) (PSQ.delete k xq) | 38 | delete k (MinMaxPSQ nq xq) = MinMaxPSQ (PSQ.delete k nq) (PSQ.delete k xq) |
39 | 39 | ||
40 | deleteMin :: (Ord k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p | 40 | deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p |
41 | deleteMin (MinMaxPSQ nq xq) = case PSQ.minView nq of | 41 | deleteMin (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 | ||
45 | deleteMax :: (Ord k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p | 45 | deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ k p -> MinMaxPSQ k p |
46 | deleteMax (MinMaxPSQ nq xq) = case PSQ.minView xq of | 46 | deleteMax (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 | ||
50 | minView :: (Ord k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) | 50 | minView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) |
51 | minView (MinMaxPSQ nq xq) = fmap (\(k :-> p, nq') -> (k :-> p, MinMaxPSQ nq' (PSQ.delete k xq))) | 51 | minView (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 | ||
54 | maxView :: (Ord k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) | 54 | maxView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k p) |
55 | maxView (MinMaxPSQ nq xq) = fmap (\(k :-> Down p, xq') -> (k :-> p, MinMaxPSQ (PSQ.delete k nq) xq')) | 55 | maxView (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 | ||
58 | insertTake :: (Ord k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p | 58 | insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p |
59 | insertTake n k p q = take n $ insert k p q | 59 | insertTake n k p q = take n $ insert k p q |
60 | 60 | ||
61 | take :: (Ord k, Ord p) => Int -> MinMaxPSQ k p -> MinMaxPSQ k p | 61 | take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ k p -> MinMaxPSQ k p |
62 | take !n !q | (size q <= n) = q | 62 | take !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 | |||
23 | import qualified Data.MinMaxPSQ as MM | 23 | import qualified Data.MinMaxPSQ as MM |
24 | ;import Data.MinMaxPSQ (MinMaxPSQ) | 24 | ;import Data.MinMaxPSQ (MinMaxPSQ) |
25 | import qualified Data.Wrapper.PSQ as PSQ | 25 | import qualified Data.Wrapper.PSQ as PSQ |
26 | ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ) | 26 | ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ, PSQKey) |
27 | import Network.Address hiding (NodeId) | 27 | import Network.Address hiding (NodeId) |
28 | import Network.DatagramServer.Types | 28 | import Network.DatagramServer.Types |
29 | import Data.Bits | 29 | import Data.Bits |
@@ -39,7 +39,8 @@ data IterativeSearch dht u ip r = IterativeSearch | |||
39 | } | 39 | } |
40 | 40 | ||
41 | newSearch :: ( Eq ip | 41 | newSearch :: ( 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 | |||
60 | sendQuery :: forall a ip dht u. | 61 | sendQuery :: 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 | ||
87 | searchIsFinished :: ( Ord ip | 89 | searchIsFinished :: ( 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 |
90 | searchIsFinished IterativeSearch{..} = do | 93 | searchIsFinished 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 | ||
100 | search :: | 103 | search :: |
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 () |
103 | search s@IterativeSearch{..} = withTaskGroup searchAlpha $ \g -> do | 106 | search s@IterativeSearch{..} = withTaskGroup searchAlpha $ \g -> do |
104 | fix $ \again -> do | 107 | fix $ \again -> do |