[Haskell-cafe] Re: [Haskell] Waiting on multiple Chan-nels

Donald Bruce Stewart dons at cse.unsw.edu.au
Tue Dec 12 20:56:06 EST 2006


sebastian.setzer.ext:
> Hi,
> How do you wait on multiple channels, but read only from one of them
> (the first that gets an entry)? Is there a library-function I missed
> which already does this?
> 
> What do you think of this solution?

Feels to heavy :) 

An alternative solution that strikes me, is to use a single chan, with a
sum type to tag the elements to be received by each thread. Then lazily
generate a list of filtered values for each thread. Then the reading
threads need do no actual IO to read.

In particular, doing the chan reading IO under a lazy stream greatly
simplifies the reader threads.

For example:

    --
    -- ghc chantest.hs -o chantest
    -- Usage: Enter "1", "2" or "0" to exit.
    --

    import System.IO
    import Control.Concurrent
    import Control.Concurrent.Chan
    import Text.Printf

    --
    -- Rather tha wait on multiple channels, it strikes me that you could
    -- have a single channel, and tag each thread's input. then lazily
    -- stream the chans contents through a filter, passing the *pure* list
    -- of filtered elements to a consuming thread
    --
    type Pipe = Chan (Either String String)

    main :: IO ()
    main = do
        chan      <- newChan :: IO Pipe
        s         <- getChanContents chan   -- lazy list of chan elements
        c1Thread  <- forkIO $ reader "c1" (catLeft  s) -- read only Lefts
        c2Thread  <- forkIO $ reader "c2" (catRight s) -- read only Rights
        writer chan
      where
        catLeft  ls = [x | Left  x <- ls]
        catRight ls = [x | Right x <- ls]

    writer :: Pipe -> IO ()
    writer chan = loop
      where
        loop = getChar >>= command
        command '0'  = print "done"
        command '1'  = writeChan chan (Left  "main: 1") >> loop
        command '2'  = writeChan chan (Right "main: 2") >> loop
        command '\n' = loop -- ignore
        command c    = printf "Illegal: %c\n" c         >> loop

    reader :: String -> [String] -> IO ()
    reader name xs = mapM_ (printf "%s %s\n" name) xs

    {-

    $ ghc x.hs -threaded

    $ ./a.out           
    1
    c1 main: 1
    2
    c2 main: 2
    2
    c2 main: 2
    1
    c1 main: 1
    2
    c2 main: 2
    3
    Illegal: 3
    1
    c1 main: 1
    2
    c2 main: 2
    0
    "done"

    -}

-- Don

P.s. redirected to haskell-cafe at haskell.org, which is more appropriate for design discussion.


More information about the Haskell-Cafe mailing list