Concurrency demos/Two reader threads

From HaskellWiki
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

This is an example of using a main thread to send messages to 2 reader threads, over a single chan. It uses lazy IO to convert the Chan into a lazy list of filtered elements, and passes the filtered lists to the reader threads. The advantage of this design is a greatly simplified reader implementation (as it need do no IO).

--
-- 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

Running this:

   $ 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"