summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Data/Bitfield.hs56
1 files changed, 35 insertions, 21 deletions
diff --git a/src/Data/Bitfield.hs b/src/Data/Bitfield.hs
index 546c68e9..024f8f71 100644
--- a/src/Data/Bitfield.hs
+++ b/src/Data/Bitfield.hs
@@ -15,14 +15,13 @@ module Data.Bitfield
15 ( Bitfield, PieceCount 15 ( Bitfield, PieceCount
16 16
17 -- * Construction 17 -- * Construction
18 , empty
19 , insert
20 , haveAll, haveNone, have 18 , haveAll, haveNone, have
21 19
22 -- * Query 20 -- * Query
23 , haveCount, totalCount, completeness 21 , haveCount, totalCount, completeness
24 , findMin, findMax 22 , findMin, findMax
25 , frequencies, rarest 23
24 , Frequency, frequencies, rarest
26 25
27 -- * Combine 26 -- * Combine
28 , union 27 , union
@@ -51,14 +50,17 @@ import Data.Serialize
51import Network.BitTorrent.PeerWire.Block 50import Network.BitTorrent.PeerWire.Block
52 51
53 52
53-- | Used to represent max set bound. Min set bound is always set to
54-- zero.
54type PieceCount = Int 55type PieceCount = Int
55 56
56-- TODO cache some operations 57-- TODO cache some operations
57 58
58-- | Bitfields are represented just as integer sets but with 59-- | Bitfields are represented just as integer sets but with
59-- restriction: the each set should be within given interval (or 60-- restriction: the each set should be within given interval (or
60-- subset of). Size is used to specify interval, so bitfield of size 61-- subset of the specified interval). Size is used to specify
61-- 10 might contain only indices in interval [0..9]. 62-- interval, so bitfield of size 10 might contain only indices in
63-- interval [0..9].
62-- 64--
63data Bitfield = Bitfield { 65data Bitfield = Bitfield {
64 bfSize :: !PieceCount 66 bfSize :: !PieceCount
@@ -69,61 +71,65 @@ data Bitfield = Bitfield {
69 71
70instance Monoid Bitfield where 72instance Monoid Bitfield where
71 {-# SPECIALIZE instance Monoid Bitfield #-} 73 {-# SPECIALIZE instance Monoid Bitfield #-}
72 mempty = empty 0 74 mempty = haveNone 0
73 mappend = union 75 mappend = union
74 mconcat = unions 76 mconcat = unions
75 77
76-- TODO documentation
77{----------------------------------------------------------------------- 78{-----------------------------------------------------------------------
78 Construction 79 Construction
79-----------------------------------------------------------------------} 80-----------------------------------------------------------------------}
80 81
81empty :: PieceCount -> Bitfield 82-- | The empty bitfield of the given size.
82empty s = Bitfield s S.empty
83
84insert :: PieceIx -> Bitfield -> Bitfield
85insert ix Bitfield {..}
86 | 0 <= ix && ix < bfSize = Bitfield bfSize (S.insert ix bfSet)
87 | otherwise = Bitfield bfSize bfSet
88
89haveNone :: PieceCount -> Bitfield 83haveNone :: PieceCount -> Bitfield
90haveNone = empty 84haveNone s = Bitfield s S.empty
91 85
86-- | The full bitfield containing all piece indices for the given size.
92haveAll :: PieceCount -> Bitfield 87haveAll :: PieceCount -> Bitfield
93haveAll s = Bitfield s (S.interval 0 (s - 1)) 88haveAll s = Bitfield s (S.interval 0 (s - 1))
94 89
90-- | Insert the index in the set ignoring out of range indices.
95have :: PieceIx -> Bitfield -> Bitfield 91have :: PieceIx -> Bitfield -> Bitfield
96have = insert 92have ix Bitfield {..}
93 | 0 <= ix && ix < bfSize = Bitfield bfSize (S.insert ix bfSet)
94 | otherwise = Bitfield bfSize bfSet
97 95
98{----------------------------------------------------------------------- 96{-----------------------------------------------------------------------
99 Query 97 Query
100-----------------------------------------------------------------------} 98-----------------------------------------------------------------------}
101 99
100-- | Count of peer have pieces.
102haveCount :: Bitfield -> PieceCount 101haveCount :: Bitfield -> PieceCount
103haveCount = S.size . bfSet 102haveCount = S.size . bfSet
104 103
104-- | Total count of pieces and its indices.
105totalCount :: Bitfield -> PieceCount 105totalCount :: Bitfield -> PieceCount
106totalCount = bfSize 106totalCount = bfSize
107 107
108-- | 108-- | Ratio of /have/ piece count to the /total/ piece count.
109-- 109--
110-- > forall bf. 0 <= completeness bf <= 1 110-- > forall bf. 0 <= completeness bf <= 1
111-- 111--
112completeness :: Bitfield -> Ratio PieceCount 112completeness :: Bitfield -> Ratio PieceCount
113completeness b = haveCount b % totalCount b 113completeness b = haveCount b % totalCount b
114 114
115-- | Find first available piece index.
115findMin :: Bitfield -> Maybe PieceIx 116findMin :: Bitfield -> Maybe PieceIx
116findMin Bitfield {..} 117findMin Bitfield {..}
117 | S.null bfSet = Nothing 118 | S.null bfSet = Nothing
118 | otherwise = Just (S.findMin bfSet) 119 | otherwise = Just (S.findMin bfSet)
119 120
121-- | Find last available piece index.
120findMax :: Bitfield -> Maybe PieceIx 122findMax :: Bitfield -> Maybe PieceIx
121findMax Bitfield {..} 123findMax Bitfield {..}
122 | S.null bfSet = Nothing 124 | S.null bfSet = Nothing
123 | otherwise = Just (S.findMax bfSet) 125 | otherwise = Just (S.findMax bfSet)
124 126
127-- | Frequencies are needed in piece selection startegies which use
128-- availability quantity to find out the optimal next piece index to
129-- download.
125type Frequency = Int 130type Frequency = Int
126 131
132-- | How many times each piece index occur in the given bitfield set.
127frequencies :: [Bitfield] -> Vector Frequency 133frequencies :: [Bitfield] -> Vector Frequency
128frequencies [] = V.fromList [] 134frequencies [] = V.fromList []
129frequencies xs = runST $ do 135frequencies xs = runST $ do
@@ -137,6 +143,7 @@ frequencies xs = runST $ do
137 where 143 where
138 size = maximum (map bfSize xs) 144 size = maximum (map bfSize xs)
139 145
146-- | Find least available piece index. If no piece available return 'Nothing'.
140rarest :: [Bitfield] -> Maybe PieceIx 147rarest :: [Bitfield] -> Maybe PieceIx
141rarest xs 148rarest xs
142 | V.null freqMap = Nothing 149 | V.null freqMap = Nothing
@@ -150,42 +157,48 @@ rarest xs
150 | otherwise = acc 157 | otherwise = acc
151 158
152 159
153
154{----------------------------------------------------------------------- 160{-----------------------------------------------------------------------
155 Combine 161 Combine
156-----------------------------------------------------------------------} 162-----------------------------------------------------------------------}
157 163
164-- | Find indices at least one peer have.
158union :: Bitfield -> Bitfield -> Bitfield 165union :: Bitfield -> Bitfield -> Bitfield
159union a b = Bitfield { 166union a b = Bitfield {
160 bfSize = bfSize a `max` bfSize b 167 bfSize = bfSize a `max` bfSize b
161 , bfSet = bfSet a `S.union` bfSet b 168 , bfSet = bfSet a `S.union` bfSet b
162 } 169 }
163 170
171-- | Find indices both peers have.
164intersection :: Bitfield -> Bitfield -> Bitfield 172intersection :: Bitfield -> Bitfield -> Bitfield
165intersection a b = Bitfield { 173intersection a b = Bitfield {
166 bfSize = bfSize a `min` bfSize b 174 bfSize = bfSize a `min` bfSize b
167 , bfSet = bfSet a `S.intersection` bfSet b 175 , bfSet = bfSet a `S.intersection` bfSet b
168 } 176 }
169 177
178-- | Find indices which have first peer but do not have the second peer.
170difference :: Bitfield -> Bitfield -> Bitfield 179difference :: Bitfield -> Bitfield -> Bitfield
171difference a b = Bitfield { 180difference a b = Bitfield {
172 bfSize = bfSize a -- FIXME is it more reasonable? 181 bfSize = bfSize a -- FIXME is it reasonable?
173 , bfSet = bfSet a `S.difference` bfSet b 182 , bfSet = bfSet a `S.difference` bfSet b
174 } 183 }
175 184
185-- |
176unions :: [Bitfield] -> Bitfield 186unions :: [Bitfield] -> Bitfield
177unions = foldl' union (empty 0) 187unions = foldl' union (haveNone 0)
178 188
179{----------------------------------------------------------------------- 189{-----------------------------------------------------------------------
180 Serialization 190 Serialization
181-----------------------------------------------------------------------} 191-----------------------------------------------------------------------}
182 192
193-- |
183getBitfield :: Int -> Get Bitfield 194getBitfield :: Int -> Get Bitfield
184getBitfield = error "getBitfield" 195getBitfield = error "getBitfield"
185 196
197-- |
186putBitfield :: Bitfield -> Put 198putBitfield :: Bitfield -> Put
187putBitfield = error "putBitfield" 199putBitfield = error "putBitfield"
188 200
201-- |
189bitfieldByteCount :: Bitfield -> Int 202bitfieldByteCount :: Bitfield -> Int
190bitfieldByteCount = error "bitfieldByteCount" 203bitfieldByteCount = error "bitfieldByteCount"
191 204
@@ -193,6 +206,7 @@ bitfieldByteCount = error "bitfieldByteCount"
193 Debug 206 Debug
194-----------------------------------------------------------------------} 207-----------------------------------------------------------------------}
195 208
209-- | For internal use only.
196mkBitfield :: PieceCount -> [PieceIx] -> Bitfield 210mkBitfield :: PieceCount -> [PieceIx] -> Bitfield
197mkBitfield s ixs = Bitfield { 211mkBitfield s ixs = Bitfield {
198 bfSize = s 212 bfSize = s