diff options
-rw-r--r-- | src/Network/BitTorrent/PeerWire/Bitfield.hs | 60 |
1 files changed, 39 insertions, 21 deletions
diff --git a/src/Network/BitTorrent/PeerWire/Bitfield.hs b/src/Network/BitTorrent/PeerWire/Bitfield.hs index 5cbd4e86..2d2bbd59 100644 --- a/src/Network/BitTorrent/PeerWire/Bitfield.hs +++ b/src/Network/BitTorrent/PeerWire/Bitfield.hs | |||
@@ -18,7 +18,9 @@ module Network.BitTorrent.PeerWire.Bitfield | |||
18 | , fromByteString, toByteString | 18 | , fromByteString, toByteString |
19 | 19 | ||
20 | -- * Query | 20 | -- * Query |
21 | , findMin, findMax, difference | 21 | , findMin, findMax |
22 | , union, intersection, difference | ||
23 | , frequencies | ||
22 | 24 | ||
23 | -- * Serialization | 25 | -- * Serialization |
24 | , getBitfield, putBitfield, bitfieldByteCount | 26 | , getBitfield, putBitfield, bitfieldByteCount |
@@ -29,7 +31,7 @@ import Data.Array.Unboxed | |||
29 | import Data.Bits | 31 | import Data.Bits |
30 | import Data.ByteString (ByteString) | 32 | import Data.ByteString (ByteString) |
31 | import qualified Data.ByteString as B | 33 | import qualified Data.ByteString as B |
32 | import Data.List as L | 34 | import Data.List as L hiding (union) |
33 | import Data.Maybe | 35 | import Data.Maybe |
34 | import Data.Serialize | 36 | import Data.Serialize |
35 | import Data.Word | 37 | import Data.Word |
@@ -45,9 +47,11 @@ newtype Bitfield = MkBitfield { | |||
45 | 47 | ||
46 | empty :: Int -> Bitfield | 48 | empty :: Int -> Bitfield |
47 | empty n = MkBitfield $ B.replicate (sizeInBase n 8) 0 | 49 | empty n = MkBitfield $ B.replicate (sizeInBase n 8) 0 |
50 | {-# INLINE empty #-} | ||
48 | 51 | ||
49 | full :: Int -> Bitfield | 52 | full :: Int -> Bitfield |
50 | full n = MkBitfield $ B.replicate (sizeInBase n 8) (complement 0) | 53 | full n = MkBitfield $ B.replicate (sizeInBase n 8) (complement 0) |
54 | {-# INLINE full #-} | ||
51 | 55 | ||
52 | fromByteString :: ByteString -> Bitfield | 56 | fromByteString :: ByteString -> Bitfield |
53 | fromByteString = MkBitfield | 57 | fromByteString = MkBitfield |
@@ -67,38 +71,52 @@ combine as@(a : _) = return $ foldr andBS empty as | |||
67 | frequencies :: [Bitfield] -> UArray PieceIx Int | 71 | frequencies :: [Bitfield] -> UArray PieceIx Int |
68 | frequencies = undefined | 72 | frequencies = undefined |
69 | 73 | ||
70 | diffWord8 :: Word8 -> Word8 -> Word8 | 74 | zipWithBF :: (Word8 -> Word8 -> Word8) -> Bitfield -> Bitfield -> Bitfield |
71 | diffWord8 a b = a .&. (a `xor` b) | 75 | zipWithBF f a b = MkBitfield $ B.pack $ B.zipWith f (bfBits a) (bfBits b) |
72 | {-# INLINE diffWord8 #-} | 76 | {-# INLINE zipWithBF #-} |
73 | 77 | ||
74 | difference :: Bitfield -> Bitfield -> Bitfield | 78 | union :: Bitfield -> Bitfield -> Bitfield |
75 | difference a b = MkBitfield $ B.pack $ B.zipWith diffWord8 (bfBits a) (bfBits b) | 79 | union = zipWithBF (.|.) |
76 | {-# INLINE difference #-} | ||
77 | 80 | ||
78 | difference' :: ByteString -> ByteString -> ByteString | 81 | intersection :: Bitfield -> Bitfield -> Bitfield |
79 | difference' a b = undefined | 82 | intersection = zipWithBF (.&.) |
83 | |||
84 | difference :: Bitfield -> Bitfield -> Bitfield | ||
85 | difference = zipWithBF diffWord8 | ||
80 | where | 86 | where |
81 | go i = undefined | 87 | diffWord8 :: Word8 -> Word8 -> Word8 |
88 | diffWord8 a b = a .&. (a `xor` b) | ||
89 | {-# INLINE diffWord8 #-} | ||
90 | {-# INLINE difference #-} | ||
82 | 91 | ||
83 | 92 | ||
84 | -- TODO: bit tricks | ||
85 | findMinWord8 :: Word8 -> Maybe Int | ||
86 | findMinWord8 b = L.findIndex (testBit b) [0..bitSize (undefined :: Word8) - 1] | ||
87 | {-# INLINE findMinWord8 #-} | ||
88 | 93 | ||
89 | -- | Get min index of piece that the peer have. | 94 | -- | Get min index of piece that the peer have. |
90 | findMin :: Bitfield -> Maybe PieceIx | 95 | findMin :: Bitfield -> Maybe PieceIx |
91 | findMin (MkBitfield b) = do | 96 | findMin (MkBitfield b) = do |
92 | byteIx <- B.findIndex (0 /=) b | 97 | byteIx <- B.findIndex (0 /=) b |
93 | bitIx <- findMinWord8 (B.index b byteIx) | 98 | bitIx <- findMinWord8 (B.index b byteIx) |
94 | return $ byteIx * bitSize (undefined :: Word8) + bitIx | 99 | return $ byteIx * bitSize (undefined :: Word8) + bitIx |
100 | where | ||
101 | -- TODO: bit tricks | ||
102 | findMinWord8 :: Word8 -> Maybe Int | ||
103 | findMinWord8 b = L.find (testBit b) [0..bitSize (undefined :: Word8) - 1] | ||
104 | {-# INLINE findMinWord8 #-} | ||
95 | {-# INLINE findMin #-} | 105 | {-# INLINE findMin #-} |
96 | 106 | ||
97 | findMaxWord8 :: Word8 -> Maybe Int | ||
98 | findMaxWord8 = error "bitfield: findMaxWord8" | ||
99 | 107 | ||
100 | findMax :: Bitfield -> Maybe PieceIx | 108 | findMax :: Bitfield -> Maybe PieceIx |
101 | findMax = error "bitfield: findMax" | 109 | findMax (MkBitfield b) = do |
110 | byteIx <- (pred (B.length b) -) <$> B.findIndex (0 /=) (B.reverse b) | ||
111 | bitIx <- findMaxWord8 (B.index b byteIx) | ||
112 | return $ byteIx * bitSize (undefined :: Word8) + bitIx | ||
113 | where | ||
114 | -- TODO: bit tricks | ||
115 | findMaxWord8 :: Word8 -> Maybe Int | ||
116 | findMaxWord8 b = L.find (testBit b) | ||
117 | (reverse [0 :: Int .. | ||
118 | bitSize (undefined :: Word8) - 1]) | ||
119 | |||
102 | {-# INLINE findMax #-} | 120 | {-# INLINE findMax #-} |
103 | 121 | ||
104 | 122 | ||