Control/Concurrent/Chan.hs

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