~ Merge selection module to bitfield.

1 files changed, 86 insertions, 1 deletions

diff --git a/src/Data/Bitfield.hs b/src/Data/Bitfield.hs
index 1ceaf78b..3c278691 100644
--- a/src/Data/Bitfield.hs
+++ b/src/Data/Bitfield.hs
@@ -9,6 +9,21 @@
 --   bitfields. Bitfields are used to keep track indices of complete
 --   pieces either peer have or client have.
 --
+--   There are also commonly used piece seletion algorithms
+--   which used to find out which one next piece to download.
+--   Selectors considered to be used in the following order:
+--
+--     * Random first - at the start.
+--
+--     * Rarest first selection - performed to avoid situation when
+--     rarest piece is unaccessible.
+--
+--     * _End game_ seletion - performed after a peer has requested all
+--     the subpieces of the content.
+--
+--   Note that BitTorrent applies the strict priority policy for
+--   /subpiece/ or /blocks/ selection.
+--
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -34,6 +49,13 @@ module Data.Bitfield
          -- * Serialization
        , fromBitmap, toBitmap
 
+         -- * Selection
+       , Selector
+       , selector, strategyClass
+
+       , strictFirst, strictLast
+       , rarestFirst, randomFirst, endGame
+
 #if  defined (TESTING)
          -- * Debug
        , mkBitfield
@@ -239,4 +261,67 @@ mkBitfield :: PieceCount -> [PieceIx] -> Bitfield
 mkBitfield s ixs = Bitfield {
     bfSize = s
   , bfSet  = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs
-  }
\ No newline at end of file
+  }
+
+{-----------------------------------------------------------------------
+    Selection
+-----------------------------------------------------------------------}
+
+type Selector =  Bitfield      -- ^ Indices of client /have/ pieces.
+             ->  Bitfield      -- ^ Indices of peer /have/ pieces.
+             -> [Bitfield]     -- ^ Indices of other peers /have/ pieces.
+             -> Maybe PieceIx  -- ^ Zero-based index of piece to request
+                               --   to, if any.
+
+selector :: Selector       -- ^ Selector to use at the start.
+         -> Ratio PieceCount
+         -> Selector       -- ^ Selector to use after the client have
+                           -- the C pieces.
+         -> Selector       -- ^ Selector that changes behaviour based
+                           -- on completeness.
+selector start pt ready   h a xs =
+  case strategyClass pt h of
+    SCBeginning -> start h a xs
+    SCReady     -> ready h a xs
+    SCEnd       -> endGame h a xs
+
+data StartegyClass
+  = SCBeginning
+  | SCReady
+  | SCEnd
+    deriving (Show, Eq, Ord, Enum, Bounded)
+
+
+strategyClass :: Ratio PieceCount -> Bitfield -> StartegyClass
+strategyClass threshold = classify . completeness
+  where
+    classify have
+      |          have < threshold     = SCBeginning
+      | have + 1 % numerator have < 1 = SCReady
+    -- FIXME numerator have is not total count
+      |           otherwise           = SCEnd
+
+
+-- | Select the first available piece.
+strictFirst :: Selector
+strictFirst h a _ = findMin (difference a h)
+
+-- | Select the last available piece.
+strictLast :: Selector
+strictLast h a _ = findMax (difference a h)
+
+-- |
+rarestFirst :: Selector
+rarestFirst h a xs = rarest (map (intersection want) xs)
+  where
+    want = difference h a
+
+-- | In average random first is faster than rarest first strategy but
+--    only if all pieces are available.
+randomFirst :: Selector
+randomFirst = do
+--  randomIO
+  error "randomFirst"
+
+endGame :: Selector
+endGame = strictLast