diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-06-30 20:26:18 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-06-30 20:26:18 +0400 |
commit | 8ecd0d15e202291324ed4f56ce3f31de420a0bda (patch) | |
tree | 9264ae6bf8043cecc52f13f43ab1e39b74686049 /src/Network/BitTorrent | |
parent | d7b276585a4faccc7d78baafb7ea011f3135856a (diff) |
+ Add some SCC annotations.
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 39 | ||||
-rw-r--r-- | src/Network/BitTorrent/Internal.hs | 5 |
2 files changed, 24 insertions, 20 deletions
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 = | |||
110 | sinkSocket sock | 110 | sinkSocket sock |
111 | 111 | ||
112 | awaitMessage :: P2P Message | 112 | awaitMessage :: P2P Message |
113 | awaitMessage = P2P $ ReaderT $ const go | 113 | awaitMessage = P2P $ ReaderT $ const $ {-# SCC awaitMessage #-} go |
114 | where | 114 | where |
115 | go = await >>= maybe (monadThrow PeerDisconnected) return | 115 | go = await >>= maybe (monadThrow PeerDisconnected) return |
116 | {-# INLINE awaitMessage #-} | 116 | {-# INLINE awaitMessage #-} |
117 | 117 | ||
118 | yieldMessage :: Message -> P2P () | 118 | yieldMessage :: Message -> P2P () |
119 | yieldMessage msg = P2P $ ReaderT $ const (C.yield msg) | 119 | yieldMessage msg = P2P $ ReaderT $ const $ {-# SCC yieldMessage #-} C.yield msg |
120 | {-# INLINE yieldMessage #-} | 120 | {-# INLINE yieldMessage #-} |
121 | 121 | ||
122 | flushPending :: P2P () | 122 | flushPending :: P2P () |
123 | flushPending = ask >>= liftIO . getPending >>= mapM_ yieldMessage | 123 | flushPending = {-# SCC flushPending #-} do |
124 | se <- ask | ||
125 | q <- liftIO (getPending se) | ||
126 | -- TODO send vectored | ||
127 | mapM_ yieldMessage q | ||
124 | 128 | ||
125 | {----------------------------------------------------------------------- | 129 | {----------------------------------------------------------------------- |
126 | P2P monad | 130 | P2P monad |
@@ -321,7 +325,7 @@ data Event | |||
321 | -- forall (Fragment block). isPiece block == True | 325 | -- forall (Fragment block). isPiece block == True |
322 | -- | 326 | -- |
323 | awaitEvent :: P2P Event | 327 | awaitEvent :: P2P Event |
324 | awaitEvent = awaitMessage >>= go | 328 | awaitEvent = {-# SCC awaitEvent #-} awaitMessage >>= go |
325 | where | 329 | where |
326 | go KeepAlive = awaitEvent | 330 | go KeepAlive = awaitEvent |
327 | go Choke = do | 331 | go Choke = do |
@@ -439,22 +443,21 @@ awaitEvent = awaitMessage >>= go | |||
439 | -- most likely will be ignored without any network IO. | 443 | -- most likely will be ignored without any network IO. |
440 | -- | 444 | -- |
441 | yieldEvent :: Event -> P2P () | 445 | yieldEvent :: Event -> P2P () |
442 | yieldEvent (Available ixs) = asks swarmSession >>= liftIO . available ixs | 446 | yieldEvent e = {-# SCC yieldEvent #-} go e |
443 | yieldEvent (Want bix) = do | 447 | where |
444 | offer <- peerOffer | 448 | go (Available ixs) = asks swarmSession >>= liftIO . available ixs |
445 | if ixPiece bix `BF.member` offer | 449 | go (Want bix) = do |
446 | then yieldMessage (Request bix) | 450 | offer <- peerOffer |
447 | else return () | 451 | if ixPiece bix `BF.member` offer |
452 | then yieldMessage (Request bix) | ||
453 | else return () | ||
448 | 454 | ||
449 | yieldEvent (Fragment blk) = do | 455 | go (Fragment blk) = do |
450 | offer <- clientOffer | 456 | offer <- clientOffer |
451 | if blkPiece blk `BF.member` offer | 457 | if blkPiece blk `BF.member` offer |
452 | then yieldMessage (Piece blk) | 458 | then yieldMessage (Piece blk) |
453 | else return () | 459 | else return () |
454 | 460 | ||
455 | 461 | ||
456 | handleEvent :: (Event -> P2P Event) -> P2P () | 462 | handleEvent :: (Event -> P2P Event) -> P2P () |
457 | handleEvent action = awaitEvent >>= action >>= yieldEvent | 463 | handleEvent action = awaitEvent >>= action >>= yieldEvent |
458 | |||
459 | checkPiece :: PieceLIx -> {-ByteString -> -} P2P Bool | ||
460 | 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 | |||
538 | -- 3. Signal to the all other peer about this. | 538 | -- 3. Signal to the all other peer about this. |
539 | 539 | ||
540 | available :: Bitfield -> SwarmSession -> IO () | 540 | available :: Bitfield -> SwarmSession -> IO () |
541 | available bf se @ SwarmSession {..} = do | 541 | available bf se @ SwarmSession {..} = {-# SCC available #-} do |
542 | mark >> atomically broadcast | 542 | mark >> atomically broadcast |
543 | where | 543 | where |
544 | mark = do | 544 | mark = do |
@@ -561,7 +561,8 @@ available bf se @ SwarmSession {..} = do | |||
561 | -- changed client state. Resulting queue should be sent to a peer | 561 | -- changed client state. Resulting queue should be sent to a peer |
562 | -- immediately. | 562 | -- immediately. |
563 | getPending :: PeerSession -> IO [Message] | 563 | getPending :: PeerSession -> IO [Message] |
564 | getPending PeerSession {..} = atomically (readAvail pendingMessages) | 564 | getPending PeerSession {..} = {-# SCC getPending #-} do |
565 | atomically (readAvail pendingMessages) | ||
565 | 566 | ||
566 | readAvail :: TChan a -> STM [a] | 567 | readAvail :: TChan a -> STM [a] |
567 | readAvail chan = do | 568 | readAvail chan = do |