[reactive] Small network-y example

[Creighton Hogg]

This is very much a work in progress, but I thought I'd share it with the
class and see if there are any suggestions.  My ultimate goal is to figure
out how to make a small MUD with Reactive.

So this is my second attempt at figuring out how we can make an adapter for
network communication.  At the moment the idea is that you can provide a
function of signature

String -> [Handle] -> IO ()

to the function adapt and you'll get back an IO () suitable for your main
loop.

> {-# OPTIONS_GHC -Wall #-}
>
> module Main where
>
> import Control.Concurrent
> import Control.Monad
> import FRP.Reactive
> import FRP.Reactive.Internal.Reactive (runE)
> import FRP.Reactive.Internal.Timing
> import FRP.Reactive.Improving
> import FRP.Reactive.LegacyAdapters
> import Network
> import System.IO
>
> pushMessage' :: [Handle] -> String -> IO ()
> pushMessage' hs s = mapM_ (flip hPutStrLn s) hs
>
> pushMessage :: Behavior [Handle] -> Event String -> Event Action
> pushMessage b e = fmap (\(s,hs) -> mapM_ (flip hPutStrLn s) hs) $ snapshot
e b
>
> messageHandler :: Handle -> Sink String -> IO ()
> messageHandler h = (hGetLine h >>=)
>
> adapt :: (Behavior [Handle] -> Event String -> Event Action) -> IO ()
> adapt f = do
>   c <- makeClock
>   (messageE,msgSink) <- makeEvent c
>   connectE <- socketServer c msgSink
>   let handles = accumB [] (fmap (:) connectE)
>   runE (sleepPast (cGetTime c) . exact) $ f handles messageE
>
> main :: IO ()
> main = adapt pushMessage
>
> socketServer :: Clock TimeT -> Sink String -> IO (Event Handle)
> socketServer c msgSink = withSocketsDo $ do
>                  (event,sink) <- makeEvent c
>                  socket <- listenOn (PortNumber 5000)
>                  forkIO $ forever $ acceptConnection socket sink msgSink
>                  return event
>
> acceptConnection :: Socket -> Sink Handle -> Sink String -> IO ThreadId
> acceptConnection s handleSink msgSink = do
>   (h,_,_) <- accept s
>   hSetBuffering h NoBuffering
>   handleSink h
>   forkIO $ forever $ messageHandler h msgSink

There are a few caveats here, though, in that I haven't yet figured out how
to handle errors or the closing of handles.  In a perfect world, in which I
am much smarter than I actually am, we'd have a properly captured notion of
disconnect events of type Event Handle that I can combine via something like
accumB [] $ (fmap (:) connectE) `mappend` (fmap delete disconnectE)

The problem I have is that I'm not sure yet how to generate the disconnect
events.

Cheers,
Creighton
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/reactive/attachments/20081112/0e523143/attachment-0001.htm