
Hi, Below is a version that was aimed at getting rid of the (Handle,IO (Request a)) tuples and as a result made it easier to remove the IO monad from some types, but I don't think it removed it completely from any methods. module Main where import Control.Applicative import Control.Concurrent import Control.Monad import Data.Reactive import Network.BSD import Network.HTTP import Network import System.IO import Text.XHtml.Strict type RequestHandler = Request -> Response main = runHttpServer helloWorldHandler helloWorldHandler :: RequestHandler helloWorldHandler = Response (2,0,0) "" [] . prettyHtml . helloWorldDoc helloWorldDoc :: Request -> Html helloWorldDoc rq = header << thetitle << "Hello World" +++ body << (h1 << "Hello World" +++ p << show rq) runHttpServer :: RequestHandler -> IO a runHttpServer r = socketServer >>= runE . fmap (handleConnection r) socketServer :: IO (Event Handle) socketServer = withSocketsDo $ do (e,snk) <- mkEventShow "Server" sock <- listenOn (PortNumber 8080) forkIO $ forever $ acceptConnection sock $ snk return e handleConnection :: Handle -> RequestHandler -> IO () handleConnection h r = handleToRequest h >>= responseSend h . runRequestHandler r handleToRequest :: Handle -> IO (Result Request) handleToRequest = receiveHTTP runRequestHandler :: RequestHandler -> Result Request -> Result Response runRequestHandler r rq = rq `bindE` (Right . r) responseSend :: Handle -> Result Response -> IO () responseSend h rsp = either print (respondHTTP h) rsp >> close h acceptConnection :: Socket -> (Handle -> IO ()) -> IO ThreadId acceptConnection s k = accept s >>= \(h,_,_) -> forkIO $ k h instance Stream Handle where readLine h = hGetLine h >>= \l -> return $ Right $ l ++ "\n" readBlock h n = replicateM n (hGetChar h) >>= return . Right writeBlock h s = mapM_ (hPutChar h) s >>= return . Right close = hClose