Move piece selection algorithms to separate module

3 files changed, 90 insertions, 74 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index e4dbd626..5bca228c 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -42,7 +42,7 @@ library
                      , RecordWildCards
   hs-source-dirs:      src
   exposed-modules:     Data.Torrent
---                     Data.Torrent.Bitfield
+                       Data.Torrent.Bitfield
                        Data.Torrent.Client
                        Data.Torrent.InfoHash
                        Data.Torrent.Layout
@@ -62,12 +62,13 @@ library
 --                     Network.BitTorrent.Exchange.Assembler
                        Network.BitTorrent.Exchange.Block
                        Network.BitTorrent.Exchange.Message
+                       Network.BitTorrent.Exchange.Selection
 --                     Network.BitTorrent.Exchange.Session
                        Network.BitTorrent.Exchange.Status
---                     Network.BitTorrent.Exchange.Wire
+                       Network.BitTorrent.Exchange.Wire
 --                     Network.BitTorrent.Tracker
---                     Network.BitTorrent.Tracker.RPC
                        Network.BitTorrent.Tracker.Message
+--                     Network.BitTorrent.Tracker.RPC
                        Network.BitTorrent.Tracker.RPC.HTTP
                        Network.BitTorrent.Tracker.RPC.UDP
                        Network.BitTorrent.Tracker.Wai
diff --git a/src/Data/Torrent/Bitfield.hs b/src/Data/Torrent/Bitfield.hs
index c7ef0998..17278a2c 100644
--- a/src/Data/Torrent/Bitfield.hs
+++ b/src/Data/Torrent/Bitfield.hs
@@ -55,13 +55,6 @@ module Data.Torrent.Bitfield
        , fromBitmap, toBitmap
        , toList
 
-         -- * Selection
-       , Selector
-       , selector, strategyClass
-
-       , strictFirst, strictLast
-       , rarestFirst, randomFirst, endGame
-
 #if  defined (TESTING)
          -- * Debug
        , mkBitfield
@@ -78,7 +71,7 @@ import qualified Data.Vector.Unboxed as V
 import qualified Data.Vector.Unboxed.Mutable as VM
 import           Data.IntervalSet (IntSet)
 import qualified Data.IntervalSet as S
-import qualified  Data.IntervalSet.ByteString as S
+import qualified Data.IntervalSet.ByteString as S
 import           Data.List (foldl')
 import           Data.Monoid
 import           Data.Ratio
@@ -289,66 +282,3 @@ mkBitfield s ixs = Bitfield {
     bfSize = s
   , bfSet  = S.splitGT (-1) $ S.splitLT s $ S.fromList ixs
   }
-
-{-----------------------------------------------------------------------
-    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 c
-      |        c < threshold       = SCBeginning
-      | c + 1 % numerator c < 1    = SCReady
-    -- FIXME numerator have is not total count
-      |          otherwise         = SCEnd
-
-
--- | Select the first available piece.
-strictFirst :: Selector
-strictFirst h a _ = Just $ findMin (difference a h)
-
--- | Select the last available piece.
-strictLast :: Selector
-strictLast h a _ = Just $ 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
diff --git a/src/Network/BitTorrent/Exchange/Selection.hs b/src/Network/BitTorrent/Exchange/Selection.hs
new file mode 100644
index 00000000..2724fabc
--- /dev/null
+++ b/src/Network/BitTorrent/Exchange/Selection.hs
@@ -0,0 +1,85 @@
+-- |
+--   Copyright   :  (c) Sam Truzjan 2013
+--   License     :  BSD3
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+--   Piece selection algorithms.
+--
+module Network.BitTorrent.Exchange.Selection
+       ( -- * Selection
+         Selector
+       , selector
+       , strategyClass
+
+       , strictFirst
+       , strictLast
+       , rarestFirst
+       , randomFirst
+       , endGame
+       ) where
+
+import Data.Ratio
+
+import Data.Torrent.Bitfield
+
+
+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 c
+      |        c < threshold       = SCBeginning
+      | c + 1 % numerator c < 1    = SCReady
+    -- FIXME numerator have is not total count
+      |          otherwise         = SCEnd
+
+
+-- | Select the first available piece.
+strictFirst :: Selector
+strictFirst h a _ = Just $ findMin (difference a h)
+
+-- | Select the last available piece.
+strictLast :: Selector
+strictLast h a _ = Just $ 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