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