diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-06-29 23:21:39 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-06-29 23:21:39 +0400 |
commit | d4ada1b8a392d67f2835935084c5f0f3ecef2ab5 (patch) | |
tree | 5240a28adcbc5d5834c61db6a224f3ad450670ae /examples | |
parent | 1d4b5f97c4323895d77aa197c3faf832c538aed9 (diff) |
+ Add throughput bench, simplify example.
Diffstat (limited to 'examples')
-rw-r--r-- | examples/Main.hs | 37 |
1 files changed, 6 insertions, 31 deletions
diff --git a/examples/Main.hs b/examples/Main.hs index fdf982d8..9786dbdc 100644 --- a/examples/Main.hs +++ b/examples/Main.hs | |||
@@ -1,13 +1,9 @@ | |||
1 | {-# LANGUAGE ViewPatterns #-} | ||
2 | {-# LANGUAGE PatternGuards #-} | ||
3 | module Main (main) where | 1 | module Main (main) where |
4 | 2 | ||
5 | import Control.Concurrent | 3 | import Control.Monad |
6 | import Data.Bitfield | ||
7 | import Network.BitTorrent | 4 | import Network.BitTorrent |
8 | import System.Environment | 5 | import System.Environment |
9 | import Control.Monad.Reader | 6 | import Control.Monad.Trans |
10 | import Data.IORef | ||
11 | 7 | ||
12 | 8 | ||
13 | main :: IO () | 9 | main :: IO () |
@@ -20,30 +16,9 @@ main = do | |||
20 | client <- newClient 100 [] | 16 | client <- newClient 100 [] |
21 | swarm <- newLeecher client torrent | 17 | swarm <- newLeecher client torrent |
22 | 18 | ||
23 | -- storage <- bindStorage swarm "/tmp/" | 19 | storage <- swarm `bindTo` "/tmp/" |
24 | -- discover swarm $ exchange storage | ||
25 | 20 | ||
26 | ref <- liftIO $ newIORef 0 | ||
27 | discover swarm $ do | 21 | discover swarm $ do |
28 | forever $ do | 22 | liftIO $ print "connected to peer" |
29 | e <- awaitEvent | 23 | forever $ exchange storage |
30 | case e of | 24 | liftIO $ print "disconnect to peer" \ No newline at end of file |
31 | Available bf | ||
32 | | Just m <- findMin bf -> yieldEvent (Want (BlockIx m 0 10)) | ||
33 | | otherwise -> return () | ||
34 | Want bix -> liftIO $ print bix | ||
35 | Fragment blk -> do | ||
36 | |||
37 | sc <- liftIO $ getSessionCount swarm | ||
38 | addr <- asks connectedPeerAddr | ||
39 | |||
40 | liftIO $ do | ||
41 | x <- atomicModifyIORef ref (\x -> (succ x, x)) | ||
42 | if x `mod` 100 == 0 | ||
43 | then print (x, sc, addr) | ||
44 | else return () | ||
45 | |||
46 | yieldEvent (Want (BlockIx 0 0 (16 * 1024))) | ||
47 | |||
48 | |||
49 | print "Bye-bye! =_=" \ No newline at end of file | ||