[Haskell-cafe] interrupting an accept()ing thread

[Thomas Conway]

On 7/6/07, Lukas Mai <l.mai at web.de> wrote:
> Hello, cafe!

Have you been reading my mind? See the other recent Cafe thread (um,
titled something about System.Exit).

Here's my solution:

acceptLoop sok reqChan = do
    req <- Network.Socket.accept sok
    atomically (writeTChan reqChan req)
    acceptLoop sok reqChan

mainLoop reqChan quitVar liveOpCountVar = do
    action <- atomically (quitNow `orElse` getReq)
    case action of
        Nothing -> return ()
        Just (reqSok,reqAddr) -> do
            atomically $ do
                liveOpCount <- readTVar liveOpCountVar
                writeTVar liveOpCountVar (liveOpCount + 1)
            forkIO (doSession reqSok reqAddr quitVar liveOpCountVar)
            mainLoop reqChan quitVar liveOpCountVar
    where
    quitNow = do
        q <- readTVar quitVar
        case q of
            True -> return Nothing
            False -> retry

    getReq = do
        req <- readTChan reqChan
        return (Just req)

doit sok = do
    reqChan <- atomically newTChan
    quitVar <- atomically (newTVar False)
    liveOpCountVar <- atomically (newTVar 0)
    forkIO (acceptLoop sok reqChan)
    mainLoop reqChan quitVar liveOpCountVar
    atomically $ do
        liveOpCount <- readTVar liveOpCountVar
        if liveOpCount > 0
            then retry
            else return ()

Although doSession is not included, obviously when you want to quit,
something in doSession should set quitVar to True. Also, as suggested
elsewhere, doSession should involve a "finally" clauses to make sure
the live op count gets decremented.

T.
-- 
Dr Thomas Conway
drtomc at gmail.com

Silence is the perfectest herald of joy:
I were but little happy, if I could say how much.