main :: IO ()
main = withSystemRandom $ \gen -> do
  shared  <- atomically $ (newTQueue :: STM (TQueue Event))
  runners <- replicateM numberOfThreads $ async (replicateM numberOfRequestsPerThread . nfIO $ action shared gen)
  worker  <- async (stats shared (\x -> (Min x, Max x, Mean 1 (fromIntegral x))))
  _       <- waitAll runners
  _       <- atomically $ writeTQueue shared Kill
  count   <- wait worker
  _       <- putStrLn . show $ count
  return () where
    action :: TQueue Event -> Gen (PrimState IO) -> IO ()
    action shared gen = do
      path              <- genString gen
      (duration, code)  <- time $ simpleHTTP (getRequest ("http://localhost/" ++ path)) >>= getResponseCode
      _                 <- atomically . writeTQueue shared $ Event (round (duration * 1000)) code
      return ()
    stats :: Monoid a => TQueue Event -> (Int -> a) -> IO (a, Counts)
    stats shared f = stats_ shared f mempty Map.empty
    stats_ :: Monoid a => TQueue Event -> (Int -> a) -> a -> Counts -> IO (a, Counts)
    stats_  shared f m counts = do
      event <- atomically $ readTQueue shared
      case event of
        Event duration code -> stats_ shared f (mappend m (f duration)) (Map.insert code ((Map.findWithDefault 0 code counts) + 1) counts)
        Kill                -> return (m, counts)


{-- TODO Move to async --}
main :: IO ()
main = withSystemRandom $ \gen -> do
  shared  <- atomically $ (newTQueue :: STM (TQueue Event))
  runners <- replicateM numberOfThreads $ async (replicateM numberOfRequestsPerThread . nfIO $ action shared gen)
  worker  <- async (stats shared (\x -> (Min x, Max x, Mean 1 (fromIntegral x))))
  _       <- waitAll runners
  _       <- atomically $ writeTQueue shared Kill
  count   <- wait worker
  _       <- putStrLn . show $ count
  return () where
    action :: TQueue Event -> Gen (PrimState IO) -> IO ()
    action shared gen = do
      path              <- genString gen
      (duration, code)  <- time $ simpleHTTP (getRequest ("http://localhost/" ++ path)) >>= getResponseCode
      _                 <- atomically . writeTQueue shared $ Event (round (duration * 1000)) code
      return ()
    stats :: Monoid a => TQueue Event -> (Int -> a) -> IO (a, Counts)
    stats shared f = stats_ shared f mempty Map.empty
    stats_ :: Monoid a => TQueue Event -> (Int -> a) -> a -> Counts -> IO (a, Counts)
    stats_  shared f m counts = do
      event <- atomically $ readTQueue shared
      case event of
        Event duration code -> stats_ shared f (mappend m (f duration)) (Map.insert code ((Map.findWithDefault 0 code counts) + 1) counts)
        Kill                -> return (m, counts)


{-- TODO Move to async --}
main = withSystemRandom $ \gen -> do
  shared  <- atomically $ (newTQueue :: STM (TQueue Event))
  runners <- replicateM numberOfThreads $ async (replicateM numberOfRequestsPerThread . nfIO $ action shared gen)
  worker  <- async (stats shared (\x -> (Min x, Max x, Mean 1 (fromIntegral x))))
  _       <- waitAll runners
  _       <- atomically $ writeTQueue shared Kill
  count   <- wait worker
  _       <- putStrLn . show $ count
  return () where
    action :: TQueue Event -> Gen (PrimState IO) -> IO ()
    action shared gen = do
      path              <- genString gen
      (duration, code)  <- time $ simpleHTTP (getRequest ("http://localhost/" ++ path)) >>= getResponseCode
      _                 <- atomically . writeTQueue shared $ Event (round (duration * 1000)) code
      return ()
    stats :: Monoid a => TQueue Event -> (Int -> a) -> IO (a, Counts)
    stats shared f = stats_ shared f mempty Map.empty
    stats_ :: Monoid a => TQueue Event -> (Int -> a) -> a -> Counts -> IO (a, Counts)
    stats_  shared f m counts = do
      event <- atomically $ readTQueue shared
      case event of
        Event duration code -> stats_ shared f (mappend m (f duration)) (Map.insert code ((Map.findWithDefault 0 code counts) + 1) counts)
        Kill                -> return (m, counts)


{-- TODO Move to async --}