Re: [Haskell-cafe] First go at reactive programming

[Levi Stephen]

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


_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe