Allow to inspect each tier from getSessionState

2 files changed, 9 insertions, 4 deletions

diff --git a/src/Network/BitTorrent/Tracker/List.hs b/src/Network/BitTorrent/Tracker/List.hs
index d92dd4ba..0eb11641 100644
--- a/src/Network/BitTorrent/Tracker/List.hs
+++ b/src/Network/BitTorrent/Tracker/List.hs
@@ -19,6 +19,7 @@ module Network.BitTorrent.Tracker.List
        , trackerList
        , shuffleTiers
        , mapWithURI
+       , Network.BitTorrent.Tracker.List.toList
 
          -- * Traversals
        , traverseAll
@@ -138,6 +139,10 @@ mapWithURI f (TierList xs      ) = TierList (L.map (L.map mapEntry) xs)
   where
     mapEntry (uri, a) = (uri, f uri a)
 
+toList :: TrackerList a -> [[TierEntry a]]
+toList (Announce   e) = [[e]]
+toList (TierList xxs) = xxs
+
 {-----------------------------------------------------------------------
 --  Special traversals (suppressed RPC exceptions)
 -----------------------------------------------------------------------}
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs
index 74d854c5..e82501dd 100644
--- a/src/Network/BitTorrent/Tracker/Session.hs
+++ b/src/Network/BitTorrent/Tracker/Session.hs
@@ -66,7 +66,7 @@ import Data.Torrent.InfoHash
 import Data.Torrent.JSON
 import Network.BitTorrent.Core
 import Network.BitTorrent.Internal.Cache
-import Network.BitTorrent.Tracker.List
+import Network.BitTorrent.Tracker.List as TL
 import Network.BitTorrent.Tracker.Message
 import Network.BitTorrent.Tracker.RPC as RPC
 
@@ -248,8 +248,8 @@ withSession m ih uris = bracket (newSession ih uris) (closeSession m)
 getStatus :: Session -> IO Status
 getStatus Session {..} = readIORef sessionStatus
 
-getSessionState :: Session -> IO (TrackerList TrackerSession)
-getSessionState Session {..} = readMVar sessionTrackers
+getSessionState :: Session -> IO [[TierEntry TrackerSession]]
+getSessionState Session {..} = TL.toList <$> readMVar sessionTrackers
 
 -- | Do we need to sent this event to a first working tracker or to
 -- the all known good trackers?
@@ -287,7 +287,7 @@ askPeers _mgr ses = do
   L.concat <$> collect (tryTakeData . trackerPeers) list
 
 collect :: (a -> IO (Maybe b)) -> TrackerList a -> IO [b]
-collect f lst =(catMaybes . toList) <$> traverse f lst
+collect f lst = (catMaybes . F.toList) <$> traverse f lst
 
 --sourcePeers :: Session -> Source (PeerAddr IP)
 --sourcePeers