Small network-y example

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

import FRP.Reactive import FRP.Reactive.Future import Data.Monoid
If I understand properly, you're interested in making a reactive adapter for network communication between 0 or more channels. I think of a network connection as both producing chunks of information and receiving chunks. Lets say the chunks are strings . . .
newtype NetConnection_ = NC_ (Event String -> Event String)
In this case, we'd also like to allow either the sender or the receiver to close the connection at some time. We could use a future for this (or simulate it with an Event)
type Future a = FutureG ITime a
newtype NetInput = NI (Event String, Future ())
chunks :: NetInput -> Event String chunks (NI a) = fst a
end :: NetInput -> Future () end (NI a) = snd a
type NetConnection = NetInput -> NetInput
Now we could query the end future of our NetConnection2:
endC :: NetInput -> NetConnection -> Future () endC i c = end (c i) `mappend` end i
To talk about multiple net connections, we need a way to allow for them not only to speak to each other, but to end eachother's connections. For this we can use.
type NetConnections = [NetInput] -> [NetInput]
The above would require the number of elements of the input be the same as the output. Anyone have some other ideas? The adapter would look like
data StaticInfo = SI adapt :: NetConnections -> StaticInfo -> IO () adapt = undefined
David
2008/11/12 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
_______________________________________________ Reactive mailing list Reactive@haskell.org http://www.haskell.org/mailman/listinfo/reactive
-- David Sankel Sankel Software
participants (2)
-
Creighton Hogg
-
David Sankel