content: {-# LANGUAGE DeriveDataTypeable #-}
  -- (c) Simon Marlow 2011, see the file LICENSE for copying terms.
  --
  -- Sample geturls.hs (CEFP summer school notes, 2011)
  --
  -- Downloading multiple URLs concurrently, timing the downloads,
  -- and the user may press 'q' to stop the downloads at any time.
  --
  -- Compile with:
  --    ghc -threaded --make geturlscancel.hs
  
  import GetURL
  import TimeIt
  
  import Data.Either
  import System.IO
  import Control.Monad
  import Control.Concurrent
  import Control.Exception
  import Text.Printf
  import qualified Data.ByteString as B
  import Data.Typeable
  import Prelude hiding (catch)
  
  -----------------------------------------------------------------------------
  -- Our Async API:
  
  data Async a = Async ThreadId (MVar (Either SomeException a))
  
  async :: IO a -> IO (Async a)
  async action = do
     m <- newEmptyMVar
     t <- forkIO (do r <- try action; putMVar m r)
     return (Async t m)
  
  wait :: Async a -> IO (Either SomeException a)
  wait (Async t var) = readMVar var
  
  cancel :: Async a -> IO ()
  cancel (Async t var) = throwTo t ThreadKilled
  
  -----------------------------------------------------------------------------
  
  sites = ["http://www.google.com",
           "http://www.bing.com",
           "http://www.yahoo.com",
           "http://www.wikipedia.com/wiki/Spade",
           "http://www.wikipedia.com/wiki/Shovel"]
  
  main = do
    as <- mapM (async.http) sites
  
    forkIO $ do
       hSetBuffering stdin NoBuffering
       forever $ do
          c <- getChar
          when (c == 'q') $ mapM_ cancel as
  
    rs <- mapM wait as
    printf "%d/%d finished\n" (length (rights rs)) (length rs)
   where
     http url = do
       (page, time) <- timeit $ getURL url
       printf "downloaded: %s (%d bytes, %.2fs)\n" url (B.length page) time
  