I'm writing a simple (chat) server inspired on Simon Marlow's book. I'm writing some unit tests where, at each case, I start the server, wait for it, and kill it.
What I would like is to define the main server thread in such a way that if it dies, all the threads spawned by it are terminated.
Currently the server looks as follows:
serve :: IO ()
serve = withSocketsDo $ do
bracket acquireSocket releaseSocket doServe
where
acquireSocket = do
putStrLn "Starting chat server"
listenOn Config.port
releaseSocket socket = do
sClose socket
putStrLn "Stopping chat server"
doServe socket = forever $ do
(h, host, port) <- accept socket
a <- async $ talk h `finally` hClose h
-- How do we cancel all the asynchronous processes if an exception is
-- raised?
return ()
If I run the tests using a simple talk function defined as:
talk :: Handle -> IO ()
talk h = do
putStrLn $ (show h) ++ " bla bla bla ..."
defaultDelay
talk h
I can see, as expected, that the talk threads keep on "talking" after their parents have died.
In Marlow's book, it is shown how a hierarchy of threads can be created using withAsync, so that if the parent dies all of its children are terminated. Using this function, the doServe function could be rewritten as follows:
doServe socket = do
(h, host, port) <- accept socket
withAsync (talk h `finally` hClose h) (\_ -> doServe socket)
Note that I've replaced forever by a recursive call to doServe.
This solution has the expected behavior, and I like its simplicity, however, I'm worried about its the memory consumption.
I've sketched other solutions, but I cannot come up with something reasonably simple and more efficient. If I have to maintain a large data structures anyway, I'd rather stick to the withAsync solution.
Any ideas?
