Channels.hs

module Main where

import Control.Concurrent (forkIO, threadDelay)
import Control.Monad 

-- from package "HTTP"
import Network.HTTP
import Network.HTTP.Headers
import Network.HTTP.Base

-- from package "synchronous-channels"
import Control.Concurrent.Chan.Synchronous

-- takes a function, builds a channel, and returns the channel
async :: (Chan a -> IO ()) -> IO (Chan a)
async f = do
  x <- newChan
  forkIO $ f x
  return x

-- helper function to actually get the data
getURL :: [Char] -> Chan String -> IO ()
getURL x ch = do 
  putStrLn $ "requesting: " ++ x ++ "..."
  y <- simpleHTTP (getRequest x) 
  z <- return (getBody y)
  writeChan ch z

-- helper function to parse the response
getBody :: Either t (Response a) -> a
getBody (Right x) = rspBody x

-- the meat of the code. 
fanIn :: [Chan a] -> IO a 
fanIn cs = loop 
  where loop = do ready <- filterM hasData cs         -- check each channel for a message
                  case (take 1 ready) of              -- grab the first one with a message
                    [x] -> readChan x                 -- retrieve the message and return
                    [] -> loop                        -- (no message) keep looping
        hasData c = do _v <- tryPeekChan c            -- peek at the channel for data
                       return $ case _v of            -- observe the type of the result
                                  Success x -> True   -- (channel has a message) return true
                                  _         -> False  -- (channel has no messages) return false

-- apply the fan-in pattern once and return a result
collectFirst :: [Chan a] -> IO a
collectFirst cs = fanIn cs

-- apply the fan-in pattern in a loop and apply 'f' to each message
collectAll :: (b -> IO a) -> [Chan b] -> IO a
collectAll f cs = loop where loop = do { fanIn cs >>= f; loop }

main :: IO ()
main = do
    -- make four requests to the same place
    a <- async $ getURL "http://garrettbluma.com"
    b <- async $ getURL "http://garrettbluma.com"
    c <- async $ getURL "http://garrettbluma.com"
    d <- async $ getURL "http://garrettbluma.com"
    
    -- only use the first one that returns
    collectFirst [a,b,c,d] >>= print

    -- collectAll print [a,b,c,d,e,f,g,h]
    -- loops forever, printing all results