From cab485585f87f73274026106235edae7765dd72e Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Tue, 18 Mar 2014 17:56:51 +0400 Subject: Allow to traverseTiers with empty tracker list --- src/Network/BitTorrent/Tracker/List.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Network/BitTorrent/Tracker/List.hs b/src/Network/BitTorrent/Tracker/List.hs index 5ab43c86..1e22f7ec 100644 --- a/src/Network/BitTorrent/Tracker/List.hs +++ b/src/Network/BitTorrent/Tracker/List.hs @@ -135,11 +135,14 @@ traverseAll action = traverse (action $?) -- | Like 'traverse' but put working trackers to the head of tiers. -- This can help to avoid exceessive requests to not available --- trackers at each reannounce. +-- trackers at each reannounce. If no one action succeed then original +-- list is returned. traverseTiers :: (a -> IO a) -> TrackerList a -> IO (TrackerList a) -traverseTiers action (Announce a) = Announce <$> action a -traverseTiers action (TierList tiers) = TierList <$> goTiers (goTier []) tiers +traverseTiers action ts = catchRPC (goList ts) (return ts) where + goList (Announce a) = Announce <$> action a + goList (TierList tiers) = TierList <$> goTiers (goTier []) tiers + goTiers _ [] = throwRPC "traverseTiers: no tiers" goTiers f (x : xs) = catchRPC shortcut failback where -- cgit v1.2.3