From 8ecd0d15e202291324ed4f56ce3f31de420a0bda Mon Sep 17 00:00:00 2001
From: Sam T <pxqr.sta@gmail.com>
Date: Sun, 30 Jun 2013 20:26:18 +0400
Subject: + Add some SCC annotations.

---
 src/Network/BitTorrent/Exchange.hs | 39 ++++++++++++++++++++------------------
 src/Network/BitTorrent/Internal.hs |  5 +++--
 2 files changed, 24 insertions(+), 20 deletions(-)

(limited to 'src/Network/BitTorrent')

diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index 66112f14..9f119d13 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -110,17 +110,21 @@ runPeerWire sock p2p =
   sinkSocket sock
 
 awaitMessage :: P2P Message
-awaitMessage = P2P $ ReaderT $ const go
+awaitMessage = P2P $ ReaderT $ const $ {-# SCC awaitMessage #-} go
   where
     go = await >>= maybe (monadThrow PeerDisconnected) return
 {-# INLINE awaitMessage #-}
 
 yieldMessage :: Message -> P2P ()
-yieldMessage msg = P2P $ ReaderT $ const (C.yield msg)
+yieldMessage msg =  P2P $ ReaderT $ const $ {-# SCC yieldMessage #-} C.yield msg
 {-# INLINE yieldMessage #-}
 
 flushPending :: P2P ()
-flushPending = ask >>= liftIO . getPending >>= mapM_ yieldMessage
+flushPending = {-# SCC flushPending #-} do
+  se <- ask
+  q  <- liftIO (getPending se)
+  -- TODO send vectored
+  mapM_ yieldMessage q
 
 {-----------------------------------------------------------------------
     P2P monad
@@ -321,7 +325,7 @@ data Event
 --     forall (Fragment block). isPiece block == True
 --
 awaitEvent :: P2P Event
-awaitEvent = awaitMessage >>= go
+awaitEvent = {-# SCC awaitEvent #-} awaitMessage >>= go
   where
     go KeepAlive = awaitEvent
     go Choke     = do
@@ -439,22 +443,21 @@ awaitEvent = awaitMessage >>= go
 --   most likely will be ignored without any network IO.
 --
 yieldEvent  :: Event -> P2P ()
-yieldEvent (Available ixs) = asks swarmSession >>= liftIO . available ixs
-yieldEvent (Want      bix) = do
-  offer <- peerOffer
-  if ixPiece bix `BF.member` offer
-     then yieldMessage (Request bix)
-     else return ()
+yieldEvent e = {-# SCC yieldEvent #-} go e
+  where
+    go (Available ixs) = asks swarmSession >>= liftIO . available ixs
+    go (Want      bix) = do
+      offer <- peerOffer
+      if ixPiece bix `BF.member` offer
+        then yieldMessage (Request bix)
+        else return ()
 
-yieldEvent (Fragment  blk) = do
-  offer <- clientOffer
-  if blkPiece blk `BF.member` offer
-    then yieldMessage (Piece blk)
-    else return ()
+    go (Fragment  blk) = do
+      offer <- clientOffer
+      if blkPiece blk `BF.member` offer
+        then yieldMessage (Piece blk)
+        else return ()
 
 
 handleEvent :: (Event -> P2P Event) -> P2P ()
 handleEvent action = awaitEvent >>= action >>= yieldEvent
-
-checkPiece :: PieceLIx -> {-ByteString -> -} P2P Bool
-checkPiece = undefined
diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index eaeb04e8..5a7e493f 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -538,7 +538,7 @@ findPieceCount = pieceCount . tInfo . torrentMeta . swarmSession
 -- 3. Signal to the all other peer about this.
 
 available :: Bitfield -> SwarmSession -> IO ()
-available bf se @ SwarmSession {..} = do
+available bf se @ SwarmSession {..} = {-# SCC available #-} do
     mark >> atomically broadcast
   where
     mark = do
@@ -561,7 +561,8 @@ available bf se @ SwarmSession {..} = do
 -- changed client state. Resulting queue should be sent to a peer
 -- immediately.
 getPending :: PeerSession -> IO [Message]
-getPending PeerSession {..} = atomically (readAvail pendingMessages)
+getPending PeerSession {..} = {-# SCC getPending #-} do
+  atomically (readAvail pendingMessages)
 
 readAvail :: TChan a -> STM [a]
 readAvail chan = do
-- 
cgit v1.2.3