Multiple async HTTP requests by Haskell

gistfile1.hs

{-# LANGUAGE FlexibleContexts #-}

import Data.Conduit
import qualified Data.Conduit.List as CL
import Network.HTTP.Conduit

import Control.Concurrent.Async (mapConcurrently)
import Control.Concurrent.MVar
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.ByteString (ByteString)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import Network.HTTP.Types.Status (statusCode)
import Text.Printf (printf)


genUrl :: String -> String
genUrl =  ("http://www.google.com/search?q="++)

urls = map genUrl ["Clojure", "Haskell", "OCaml", "Scala", "F#"]
       ++ ["http://127.0.0.1:3000/"]
       ++ map genUrl ["Ruby", "Python", "Perl", "PHP", "JavaScript"]


curl :: (MonadResource m, MonadBaseControl IO m) =>
        String -> m (Response (ResumableSource m ByteString))
curl url = do
  request <- liftIO $ parseUrl url
  manager <- liftIO $ newManager def
  http (request { checkStatus = \_ _ -> Nothing,
                  responseTimeout = Just 10000000 }) manager

operation :: MVar a -> Int -> String -> IO ()
operation lock i url = runResourceT $ do
  start <- liftIO getCurrentTime
  Response status _ _ body <- curl url
  body $$+- CL.consume
  end   <- liftIO getCurrentTime
  liftIO $ withMVar lock $ \_ -> 
    printf "%8.3f: %2d: %s => %d\n"
           (realToFrac (diffUTCTime end start) :: Double)
           i url (statusCode status)


main :: IO ()
main = do
  lock <- newMVar ()
  mapConcurrently (uncurry (operation lock)) $ zip [1..] urls
  return ()


-- To check async process, prepare a long time request:
-- $ plackup -p 3000 -e 'sub { sleep 5; return [200, ["Content-Type" => "text/plain"], ["Hello World."]] }'

-- ghci> main
--    0.219:  4: http://www.google.com/search?q=Scala => 200
--    0.230:  1: http://www.google.com/search?q=Clojure => 200
--    0.228:  8: http://www.google.com/search?q=Python => 200
--    0.249:  2: http://www.google.com/search?q=Haskell => 200
--    0.257:  9: http://www.google.com/search?q=Perl => 200
--    0.257: 10: http://www.google.com/search?q=PHP => 200
--    0.264:  5: http://www.google.com/search?q=F# => 200
--    0.267:  7: http://www.google.com/search?q=Ruby => 200
--    0.515: 11: http://www.google.com/search?q=JavaScript => 200
--    0.746:  3: http://www.google.com/search?q=OCaml => 200
--    5.044:  6: http://127.0.0.1:3000/ => 200