[Haskell] Faucet and drain programs no worky

4 Jun 2006

      Well, I was needing to make some circular pipelines, so I whipped up a
pair of programs called "faucet" and "drain". Stuff would flow into
the drain at the end of the pipe, when it comes out of the faucet at
the beginning. Here's the drain program:
...
module Main where
import Network
import System.IO
import System.Environment(getArgs)
main = withSocketsDo $ do
         input <- getContents
         (args:_) <- getArgs
         let port = PortNumber (fromInteger (read args))
         sock <- listenOn port
         loop sock input
  where loop sock input = do (handle, hostname, _) <- accept sock
                             hSetBuffering handle NoBuffering
                             if hostname == "localhost"
                                then hLazyPutStr handle input
                                else return ()
                             hClose handle
                             loop sock input
hLazyPutStr handle = foldr (\x xs -> hPutChar handle x >> xs) (return ())
And the faucet (much simpler, no?):
...
module Main where
import Network
import System.IO
import System.Environment(getArgs)
main = withSocketsDo $ do
         (args:_) <- getArgs
         let port = PortNumber (fromInteger (read args))
         conn <- connectTo "localhost" port
         hGetContents conn >>= putStr
The problem: each drain only seems to support one faucet. You only
need multiple faucets if you want to branch off and stuff, but I like
my programs to be perfect :-) (By the way, the drain should send the
entirety of its input to every faucet, no matter when they connect.)

The other problem is that the faucet doesn't wait forever for a drain
to appear, but I'd like it to. How can I fix these problems?

--ihope