From 9c551511ae5a0d6cf7fc77daf6bd6b16b8eb8977 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Mon, 16 Jan 2017 23:04:35 -0500
Subject: Clean up all warnings (ghc 8.0.1) in DHT component.

---
 src/Network/BitTorrent/DHT/Routing.hs | 53 +++++++++++------------------------
 1 file changed, 17 insertions(+), 36 deletions(-)

(limited to 'src/Network/BitTorrent/DHT/Routing.hs')

diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs
index 84e4d4ce..f9d64eea 100644
--- a/src/Network/BitTorrent/DHT/Routing.hs
+++ b/src/Network/BitTorrent/DHT/Routing.hs
@@ -144,7 +144,7 @@ instance Alternative (Routing ip) where
   Refresh  n f <|> m = Refresh  n (f <|> m)
 
 -- | Run routing table operation.
-runRouting :: (Monad m, Eq ip)
+runRouting :: Monad m
            => (NodeAddr ip -> m Bool) -- ^ ping the specific node;
            -> (NodeId      -> m ())   -- ^ refresh nodes;
            -> m Timestamp             -- ^ get current time;
@@ -166,18 +166,6 @@ runRouting ping_node find_nodes timestamper = go
       find_nodes nid
       go f
 
-getTime :: Routing ip Timestamp
-getTime = GetTime return
-{-# INLINE getTime #-}
-
-needPing :: NodeAddr ip -> Routing ip Bool
-needPing addr = NeedPing addr return
-{-# INLINE needPing #-}
-
-refresh :: NodeId -> Routing ip ()
-refresh nid = Refresh nid (Done ())
-{-# INLINE refresh #-}
-
 {-----------------------------------------------------------------------
     Bucket
 -----------------------------------------------------------------------}
@@ -213,6 +201,7 @@ data QueueMethods m elem fifo = QueueMethods
     , emptyQueue :: m fifo
     }
 
+{-
 fromQ :: Functor m =>
        ( a -> b )
        -> ( b -> a )
@@ -223,6 +212,7 @@ fromQ embed project QueueMethods{..} =
                  , popFront = fmap (second embed) . popFront . project
                  , emptyQueue = fmap embed emptyQueue
                  }
+-}
 
 seqQ :: QueueMethods Identity (NodeInfo ip) (Seq.Seq (NodeInfo ip))
 seqQ = QueueMethods
@@ -256,17 +246,6 @@ instance (Serialize k, Serialize v, Ord k, Ord v)
   get = PSQ.fromList <$> get
   put = put . PSQ.toList
 
--- | Get the most recently changed node entry, if any.
-lastChanged :: Eq ip => Bucket ip -> Maybe (NodeEntry ip)
-lastChanged bucket
-  | L.null timestamps = Nothing
-  |      otherwise    = Just (L.maximumBy (compare `on` prio) timestamps)
-  where
-    timestamps = PSQ.toList $ bktNodes bucket
-
-leastRecently :: Eq ip => Bucket ip -> Maybe (NodeEntry ip, Bucket ip)
-leastRecently b = fmap (\(e,ns) -> (e, b { bktNodes = ns })) $ minView $ bktNodes b
-
 -- | Update interval, in seconds.
 delta :: NominalDiffTime
 delta = 15 * 60
@@ -303,29 +282,30 @@ insertBucket curTime (TryInsert info) bucket
     map_q f = bucket { bktQ = runIdentity $ f (bktQ bucket) }
 
 insertBucket curTime (PingResult bad_node got_response) bucket
-    = pure ([], Bucket (update $ bktNodes bucket) popped)
+    = pure ([], Bucket (upd $ bktNodes bucket) popped)
  where
     (top, popped) = runIdentity $ popFront bucketQ (bktQ bucket)
-    update | got_response     = id
-           | Just info <- top = PSQ.insert info curTime . PSQ.delete bad_node
-           | otherwise        = id
+    upd | got_response     = id
+        | Just info <- top = PSQ.insert info curTime . PSQ.delete bad_node
+        | otherwise        = id
 
 type BitIx = Word
 
-partitionQ imp pred q = do
-    pass <- emptyQueue imp
-    fail <- emptyQueue imp
+partitionQ :: Monad f => QueueMethods f elem b -> (elem -> Bool) -> b -> f (b, b)
+partitionQ imp test q0 = do
+    pass0 <- emptyQueue imp
+    fail0 <- emptyQueue imp
     let flipfix a b f = fix f a b
-    flipfix q (pass,fail) $ \loop q qs -> do
+    flipfix q0 (pass0,fail0) $ \rec q qs -> do
         (mb,q') <- popFront imp q
         case mb of
             Nothing -> return qs
             Just e  -> do qs' <- select (pushBack imp e) qs
-                          loop q' qs'
+                          rec q' qs'
                 where
                     select :: Functor f => (b -> f b) -> (b, b) -> f (b, b)
-                    select f = if pred e then \(a,b) -> flip (,) b <$> f a
-                                           else \(a,b) ->      (,) a <$> f b
+                    select f = if test e then \(a,b) -> flip (,) b <$> f a
+                                         else \(a,b) ->      (,) a <$> f b
 
 split :: Eq ip => BitIx -> Bucket ip -> (Bucket ip, Bucket ip)
 split i b = (Bucket ns qs, Bucket ms rs)
@@ -529,7 +509,7 @@ splitTip nid n i bucket
 -- k nodes in them.  Which subtrees I mean is illustrated in Fig 1. of Kademlia
 -- paper.  The rule requiring additional splits is in section 2.4.
 modifyBucket
-  :: forall f ip xs. (Alternative f, Eq ip, Monoid xs) =>
+  :: forall f ip xs. (Alternative f, Eq ip) =>
      NodeId -> (Bucket ip -> f (xs, Bucket ip)) -> Table ip -> f (xs,Table ip)
 modifyBucket nodeId f = go (0 :: BitIx)
   where
@@ -552,6 +532,7 @@ data Event ip = TryInsert { foreignNode :: NodeInfo ip }
                            }
     deriving (Eq,Ord,Show)
 
+eventId :: Event ip -> NodeId
 eventId (TryInsert NodeInfo{..})    = nodeId
 eventId (PingResult NodeInfo{..} _) = nodeId
 
-- 
cgit v1.2.3