[reactive] Small network-y example

12 Nov 2008

      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

[reactive] Small network-y example

Creighton Hogg