Control/Concurrent/Chan.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Control.Concurrent.Chan
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable (concurrency).
  10 --
  11 -- Unbounded channels.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module Control.Concurrent.Chan
  16   (
  17           -- * The 'Chan' type
  18         Chan,                   -- abstract
  19
  20           -- * Operations
  21         newChan,                -- :: IO (Chan a)
  22         writeChan,              -- :: Chan a -> a -> IO ()
  23         readChan,               -- :: Chan a -> IO a
  24         dupChan,                -- :: Chan a -> IO (Chan a)
  25         unGetChan,              -- :: Chan a -> a -> IO ()
  26         isEmptyChan,            -- :: Chan a -> IO Bool
  27
  28           -- * Stream interface
  29         getChanContents,        -- :: Chan a -> IO [a]
  30         writeList2Chan,         -- :: Chan a -> [a] -> IO ()
  31    ) where
  32
  33 import Prelude
  34
  35 import System.IO.Unsafe         ( unsafeInterleaveIO )
  36 import Control.Concurrent.MVar
  37
  38 -- A channel is represented by two @MVar@s keeping track of the two ends
  39 -- of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s
  40 -- are used to handle consumers trying to read from an empty channel.
  41
  42 -- |'Chan' is an abstract type representing an unbounded FIFO channel.
  43 data Chan a
  44  = Chan (MVar (Stream a))
  45         (MVar (Stream a))
  46
  47 type Stream a = MVar (ChItem a)
  48
  49 data ChItem a = ChItem a (Stream a)
  50
  51 -- See the Concurrent Haskell paper for a diagram explaining the
  52 -- how the different channel operations proceed.
  53
  54 -- @newChan@ sets up the read and write end of a channel by initialising
  55 -- these two @MVar@s with an empty @MVar@.
  56
  57 -- |Build and returns a new instance of 'Chan'.
  58 newChan :: IO (Chan a)
  59 newChan = do
  60    hole  <- newEmptyMVar
  61    read  <- newMVar hole
  62    write <- newMVar hole
  63    return (Chan read write)
  64
  65 -- To put an element on a channel, a new hole at the write end is created.
  66 -- What was previously the empty @MVar@ at the back of the channel is then
  67 -- filled in with a new stream element holding the entered value and the
  68 -- new hole.
  69
  70 -- |Write a value to a 'Chan'.
  71 writeChan :: Chan a -> a -> IO ()
  72 writeChan (Chan _read write) val = do
  73   new_hole <- newEmptyMVar
  74   modifyMVar_ write $ \old_hole -> do
  75     putMVar old_hole (ChItem val new_hole)
  76     return new_hole
  77
  78 -- |Read the next value from the 'Chan'.
  79 readChan :: Chan a -> IO a
  80 readChan (Chan read _write) = do
  81   modifyMVar read $ \read_end -> do
  82     (ChItem val new_read_end) <- readMVar read_end
  83         -- Use readMVar here, not takeMVar,
  84         -- else dupChan doesn't work
  85     return (new_read_end, val)
  86
  87 -- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to
  88 -- either channel from then on will be available from both.  Hence this creates
  89 -- a kind of broadcast channel, where data written by anyone is seen by
  90 -- everyone else.
  91 dupChan :: Chan a -> IO (Chan a)
  92 dupChan (Chan _read write) = do
  93    hole     <- readMVar write
  94    new_read <- newMVar hole
  95    return (Chan new_read write)
  96
  97 -- |Put a data item back onto a channel, where it will be the next item read.
  98 unGetChan :: Chan a -> a -> IO ()
  99 unGetChan (Chan read _write) val = do
 100    new_read_end <- newEmptyMVar
 101    modifyMVar_ read $ \read_end -> do
 102      putMVar new_read_end (ChItem val read_end)
 103      return new_read_end
 104
 105 -- |Returns 'True' if the supplied 'Chan' is empty.
 106 isEmptyChan :: Chan a -> IO Bool
 107 isEmptyChan (Chan read write) = do
 108    withMVar read $ \r -> do
 109      w <- readMVar write
 110      let eq = r == w
 111      eq `seq` return eq
 112
 113 -- Operators for interfacing with functional streams.
 114
 115 -- |Return a lazy list representing the contents of the supplied
 116 -- 'Chan', much like 'IO.hGetContents'.
 117 getChanContents :: Chan a -> IO [a]
 118 getChanContents ch
 119   = unsafeInterleaveIO (do
 120         x  <- readChan ch
 121         xs <- getChanContents ch
 122         return (x:xs)
 123     )
 124
 125 -- |Write an entire list of items to a 'Chan'.
 126 writeList2Chan :: Chan a -> [a] -> IO ()
 127 writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)