'accept' does not seem to be thread friendly ..

[Ahn Ki-yung]

John Meacham wrote:

>that is what Concurrent is for, Haskell threads, (well GHC threads) are
>lightweight and can be used for selectlike purposes without too much
>overhead. I use them quite effectivly for complex networked
>applications..
>
>see
>http://haskell.org/ghc/docs/latest/html/base/Control.Concurrent.html
>
>  
>
Below is my sample code ; the Net Cats
This does not work, because 'accept' fuction of the
Network module blocks the whole process, unlike
Haskell Standard IO functions which blocks its thread
only. How did you work around with complex networked
applications ? It would be very helpful if you could
give us more detailed advice from your expierience.

Network.accept does not seem to be thread friendly.
Then how am I going to keep my server from being blocked
by accept?

\begin{code}

import IO
import Monad
import Network
import Control.Exception (finally)
import Control.Concurrent

hCat inh outh = repeat $ try (hGetLine inh>>=hPutStrLn outh>>hFlush outh)

isRight (Right _) = True
isRight _ = False

dostep actss = filterM ((>>=return.isRight).head) actss

theloop [] = return []
theloop actss = dostep actss >>= theloop

thd_accept lsock mvar = do
	actss <- takeMVar mvar
	print "trying to accept"
	conn@(h,host,port) <- accept lsock
	print conn
	putMVar mvar (hCat h h:actss)
	thd_accept lsock mvar

loopcats mvar = takeMVar mvar >>= dostep >>= putMVar mvar >> loopcats mvar

main = withSocketsDo $ do
	lsock <- listenOn $ PortNumber 9000
	print lsock
	mvar <- newMVar []
	forkIO (thd_accept lsock mvar `finally` putMVar mvar [])
	loopcats mvar `finally` putMVar mvar []

\end{code}


-- 
Ahn Ki-yung