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