diff --git a/Control/Concurrent/BroadcastChan.hs b/Control/Concurrent/BroadcastChan.hs new file mode 100644 --- /dev/null +++ b/Control/Concurrent/BroadcastChan.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE AutoDeriveTypeable #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE Trustworthy #-} +------------------------------------------------------------------------------- +-- | +-- Module : Contro.Concurrent.BroadcastChan +-- Copyright : (C) 2014 Merijn Verstraaten +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Merijn Verstraaten +-- Stability : experimental +-- Portability : haha +-- +-- A variation of "Control.Concurrent.Chan" from base, which allows to the easy +-- creation of broadcast channels without the space-leaks that may arise from +-- using 'Control.Concurrent.Chan.dupChan'. +-- +-- The 'Control.Concurrent.Chan.Chan' type from "Control.Concurrent.Chan" +-- consists of both a read and write end. This presents a problem when one +-- wants to have a broadcast channel that, at times, has zero listeners. To +-- write to a 'Control.Concurrent.Chan.Chan' there must always be a read end +-- and this read end will hold ALL messages alive until read. +-- +-- The simple solution applied in this module is to separate read and write +-- ends. As a result, any messages written to the write end can be immediately +-- garbage collected if there are no active read ends, avoding space leaks. +------------------------------------------------------------------------------- +module Control.Concurrent.BroadcastChan + ( BroadcastChan + , In + , Out + , newBroadcastChan + , writeBChan + , readBChan + , newBChanListener + ) where + +import Control.Concurrent.MVar +import Control.Exception (mask_) + +data Direction = In | Out + +-- | Alias for the 'In' type from the 'Direction' kind, allows users to write +-- the 'BroadcastChan In a' type without enabling DataKinds. +type In = 'In +-- | Alias for the 'Out' type from the 'Direction' kind, allows users to write +-- the 'BroadcastChan Out a' type without enabling DataKinds. +type Out = 'Out + +-- | The abstract type representing the read or write end of a 'BroadcastChan'. +data BroadcastChan :: Direction -> * -> * where + WriteEnd :: {-# UNPACK #-} !(MVar (Stream a)) -> BroadcastChan In a + ReadEnd :: {-# UNPACK #-} !(MVar (Stream a)) -> BroadcastChan Out a + +deriving instance Eq (BroadcastChan i a) + +type Stream a = MVar (ChItem a) + +data ChItem a = ChItem a {-# UNPACK #-} !(Stream a) + +-- | Creates a new 'BroadcastChan' write end. +newBroadcastChan :: IO (BroadcastChan In a) +newBroadcastChan = do + hole <- newEmptyMVar + writeVar <- newMVar hole + return (WriteEnd writeVar) + +-- | Write a value to write end of a 'BroadcastChan'. Any messages written +-- while there are no live read ends can be immediately garbage collected, thus +-- avoiding space leaks. +writeBChan :: BroadcastChan In a -> a -> IO () +writeBChan (WriteEnd writeVar) val = do + new_hole <- newEmptyMVar + mask_ $ do + old_hole <- takeMVar writeVar + putMVar old_hole (ChItem val new_hole) + putMVar writeVar new_hole + +-- | Read the next value from the read end of a 'BroadcastChan'. +readBChan :: BroadcastChan Out a -> IO a +readBChan (ReadEnd readVar) = do + modifyMVarMasked readVar $ \read_end -> do -- Note [modifyMVarMasked] + (ChItem val new_read_end) <- readMVar read_end + -- Use readMVar here, not takeMVar, + -- else dupBroadcastChan doesn't work + return (new_read_end, val) + +-- | Create a new read end for a 'BroadcastChan'. Will receive all messages +-- written to the channel's write end after the read end's creation. +newBChanListener :: BroadcastChan In a -> IO (BroadcastChan Out a) +newBChanListener (WriteEnd writeVar) = do + hole <- readMVar writeVar + newReadVar <- newMVar hole + return (ReadEnd newReadVar) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Merijn Verstraaten + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Merijn Verstraaten nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/broadcast-chan.cabal b/broadcast-chan.cabal new file mode 100644 --- /dev/null +++ b/broadcast-chan.cabal @@ -0,0 +1,50 @@ +Name: broadcast-chan +Version: 0.1.0 + +Homepage: https://github.com/merijn/broadcast-chan +Bug-Reports: https://github.com/merijn/broadcast-chan/issues + +Author: Merijn Verstraaten +Maintainer: Merijn Verstraaten +Copyright: Copyright © 2014 Merijn Verstraaten + +License: BSD3 +License-File: LICENSE + +Category: System +Cabal-Version: >= 1.10 +Build-Type: Simple +Tested-With: GHC == 7.8.3 + +Synopsis: Broadcast channel type that avoids 0 reader space leaks. + +Description: + A variation of "Control.Concurrent.Chan" from base, which allows to the + easy creation of broadcast channels without the space-leaks that may arise + from using 'Control.Concurrent.Chan.dupChan'. + + The 'Control.Concurrent.Chan.Chan' type from "Control.Concurrent.Chan" + consists of both a read and write end. This presents a problem when one + wants to have a broadcast channel that, at times, has zero listeners. To + write to a 'Control.Concurrent.Chan.Chan' there must always be a read end + and this read end will hold ALL messages alive until read. + + The simple solution applied in this module is to separate read and write + ends. As a result, any messages written to the write end can be immediately + garbage collected if there are no active read ends, avoding space leaks. + +Library + Default-Language: Haskell2010 + GHC-Options: -Wall -fno-warn-unused-do-bind + GHC-Prof-Options: -auto-all -caf-all -rtsopts + Exposed-Modules: Control.Concurrent.BroadcastChan + + Build-Depends: base >= 4 && < 5 + +Source-Repository head + Type: mercurial + Location: https://bitbucket.org/merijnv/broadcast-chan + +Source-Repository head + Type: mercurial + Location: git+ssh://github.com:merijn/broadcast-chan