diff --git a/BroadcastChan.hs b/BroadcastChan.hs --- a/BroadcastChan.hs +++ b/BroadcastChan.hs @@ -5,7 +5,7 @@ ------------------------------------------------------------------------------- -- | -- Module : BroadcastChan --- Copyright : (C) 2014-2018 Merijn Verstraaten +-- Copyright : (C) 2014-2021 Merijn Verstraaten -- License : BSD-style (see the file LICENSE) -- Maintainer : Merijn Verstraaten -- Stability : experimental diff --git a/BroadcastChan/Extra.hs b/BroadcastChan/Extra.hs --- a/BroadcastChan/Extra.hs +++ b/BroadcastChan/Extra.hs @@ -6,7 +6,7 @@ ------------------------------------------------------------------------------- -- | -- Module : BroadcastChan.Extra --- Copyright : (C) 2014-2018 Merijn Verstraaten +-- Copyright : (C) 2014-2021 Merijn Verstraaten -- License : BSD-style (see the file LICENSE) -- Maintainer : Merijn Verstraaten -- Stability : experimental @@ -38,7 +38,7 @@ import Control.Concurrent.QSemN import Control.Exception (Exception(..), SomeException(..), bracketOnError) import qualified Control.Exception as Exc -import Control.Monad ((>=>), replicateM, void) +import Control.Monad ((>=>), join, replicateM, void) import Control.Monad.Trans.Cont (ContT(..)) import Control.Monad.IO.Unlift (MonadIO(..)) import Data.Typeable (Typeable) @@ -150,6 +150,7 @@ inChanOut <- newBChanListener inChanIn shutdownSem <- newQSemN 0 endSem <- newQSemN 0 + excMVar <- newMVar (Exc.throwTo originTid) let bufferValue :: a -> IO () bufferValue = void . writeBChan inChanIn @@ -183,8 +184,12 @@ case exit of Left exc | Just Shutdown <- fromException exc -> cleanupForkError - | otherwise -> - Exc.throwTo originTid exc `Exc.catch` shutdownHandler + | otherwise -> do + cleanupForkError + reportErr <- tryTakeMVar excMVar + case reportErr of + Nothing -> return () + Just throw -> throw exc `Exc.catch` shutdownHandler Right () -> cleanupFork mkWeakThreadId tid @@ -301,7 +306,7 @@ let queueAndYield :: a -> m (Maybe b) queueAndYield x = do - ~(Just v) <- liftIO $ readBChan outChanOut <* bufferValue x + v <- join <$> liftIO (readBChan outChanOut <* bufferValue x) return v finish :: r -> n r diff --git a/BroadcastChan/Internal.hs b/BroadcastChan/Internal.hs --- a/BroadcastChan/Internal.hs +++ b/BroadcastChan/Internal.hs @@ -14,12 +14,12 @@ data Direction = In -- ^ Indicates a write 'BroadcastChan' | Out -- ^ Indicates a read 'BroadcastChan' --- | Alias for the 'In' type from the 'Direction' kind, allows users to write --- the @'BroadcastChan' 'In' a@ type without enabling @DataKinds@. +-- | Alias for the v'In' type from the 'Direction' kind, allows users to write +-- the @'BroadcastChan' v'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@. +-- | Alias for the v'Out' type from the 'Direction' kind, allows users to write +-- the @'BroadcastChan' v'Out' a@ type without enabling @DataKinds@. type Out = 'Out -- | The abstract type representing the read or write end of a 'BroadcastChan'. @@ -49,7 +49,7 @@ -- | Check whether a 'BroadcastChan' is closed. 'True' meaning that future -- read/write operations on the channel will always fail. -- --- ['BroadcastChan' 'In':]: +-- ['BroadcastChan' v'In':]: -- -- @True@ indicates the channel is closed and writes will always fail. -- @@ -58,7 +58,7 @@ -- a 'closeBChan' from another thread can result in the channel being -- closed right after 'isClosedBChan' returns. -- --- ['BroadcastChan' 'Out':]: +-- ['BroadcastChan' v'Out':]: -- -- @True@ indicates the channel is both closed and empty, meaning reads -- will always fail. @@ -116,12 +116,12 @@ -- | Create a new read end for a 'BroadcastChan'. -- --- ['BroadcastChan' 'In':]: +-- ['BroadcastChan' v'In':]: -- -- Will receive all messages written to the channel __after__ this read -- end is created. -- --- ['BroadcastChan' 'Out':]: +-- ['BroadcastChan' v'Out':]: -- -- Will receive all currently unread messages and all future messages. newBChanListener :: MonadIO m => BroadcastChan dir a -> m (BroadcastChan Out a) @@ -134,12 +134,12 @@ -- -- Uses 'unsafeInterleaveIO' to defer the IO operations. -- --- ['BroadcastChan' 'In':]: +-- ['BroadcastChan' v'In':]: -- -- The list contains every message written to the channel after this 'IO' -- action completes. -- --- ['BroadcastChan' 'Out':]: +-- ['BroadcastChan' v'Out':]: -- -- The list contains every currently unread message and all future -- messages. It's safe to keep using the original channel in any thread. @@ -170,11 +170,11 @@ -- completes when the channel is closed and exhausted. The outer action -- controls from when on messages are received. Specifically: -- --- ['BroadcastChan' 'In':]: +-- ['BroadcastChan' v'In':]: -- -- Will process all messages sent after the outer action completes. -- --- ['BroadcastChan' 'Out':]: +-- ['BroadcastChan' v'Out':]: -- -- Will process all messages that are unread when the outer action -- completes, as well as all future messages. diff --git a/BroadcastChan/Prelude.hs b/BroadcastChan/Prelude.hs --- a/BroadcastChan/Prelude.hs +++ b/BroadcastChan/Prelude.hs @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------- -- | -- Module : BroadcastChan.Prelude --- Copyright : (C) 2014-2018 Merijn Verstraaten +-- Copyright : (C) 2014-2021 Merijn Verstraaten -- License : BSD-style (see the file LICENSE) -- Maintainer : Merijn Verstraaten -- Stability : experimental diff --git a/BroadcastChan/Throw.hs b/BroadcastChan/Throw.hs --- a/BroadcastChan/Throw.hs +++ b/BroadcastChan/Throw.hs @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------- -- | -- Module : BroadcastChan.Throw --- Copyright : (C) 2014-2018 Merijn Verstraaten +-- Copyright : (C) 2014-2021 Merijn Verstraaten -- License : BSD-style (see the file LICENSE) -- Maintainer : Merijn Verstraaten -- Stability : experimental diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +0.2.1.2 [2021.12.01] +-------------------- +* Update bounds for GHC 9.0 and 9.2. +* Hacky fix of a tricky race condition + [#3](https://github.com/merijn/broadcast-chan/issues/3). + 0.2.1.1 [2020.03.05] -------------------- * Updated imports to support `unliftio-core` 0.2.x diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013-2017, Merijn Verstraaten +Copyright (c) 2013-2021, Merijn Verstraaten All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ [![Hackage](https://img.shields.io/hackage/v/broadcast-chan.svg)](https://hackage.haskell.org/package/broadcast-chan) [![hackage-ci](https://matrix.hackage.haskell.org/api/v2/packages/broadcast-chan/badge)](https://matrix.hackage.haskell.org/#/package/broadcast-chan) [![Stackage](https://www.stackage.org/package/broadcast-chan/badge/lts?label=Stackage)](https://www.stackage.org/package/broadcast-chan) -[![Build Status](https://travis-ci.org/merijn/broadcast-chan.svg)](https://travis-ci.org/merijn/broadcast-chan) +[![Build Status](https://travis-ci.com/merijn/broadcast-chan.svg?branch=master)](https://travis-ci.com/merijn/broadcast-chan) A closable, fair, single-wakeup channel that avoids the 0 reader space leak that `Control.Concurrent.Chan` from base suffers from. diff --git a/benchmarks/Channels.hs b/benchmarks/Channels.hs --- a/benchmarks/Channels.hs +++ b/benchmarks/Channels.hs @@ -3,7 +3,6 @@ {-# LANGUAGE RecordWildCards #-} import Criterion.Main -import Control.Applicative ((<$>)) import Control.Concurrent (setNumCapabilities) import Control.Concurrent.Async import BroadcastChan diff --git a/broadcast-chan.cabal b/broadcast-chan.cabal --- a/broadcast-chan.cabal +++ b/broadcast-chan.cabal @@ -1,21 +1,21 @@ +Cabal-Version: 2.2 Name: broadcast-chan -Version: 0.2.1.1 +Version: 0.2.1.2 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-2019 Merijn Verstraaten +Copyright: Copyright © 2014-2021 Merijn Verstraaten -License: BSD3 +License: BSD-3-Clause License-File: LICENSE Category: System -Cabal-Version: >= 1.10 Build-Type: Simple Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, - GHC == 8.8.3, GHC == 8.10.1 + GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.1, GHC == 9.2.1 Extra-Source-Files: README.md , CHANGELOG.md @@ -83,7 +83,7 @@ Library Default-Language: Haskell2010 - GHC-Options: -Wall -O2 -fno-warn-unused-do-bind + GHC-Options: -Wall -O2 -Wno-unused-do-bind Exposed-Modules: BroadcastChan BroadcastChan.Extra @@ -100,63 +100,57 @@ Trustworthy TupleSections - Build-Depends: base >= 4.7 && < 4.15 - , transformers >= 0.2 && < 0.6 + Build-Depends: base >= 4.8 && < 4.17 + , transformers >= 0.2 && < 0.7 , unliftio-core >= 0.1.1 && < 0.3 -Benchmark sync +Common concurrent-benchmarks Default-Language: Haskell2010 - Type: exitcode-stdio-1.0 - Main-Is: Sync.hs - GHC-Options: -Wall -O2 -fno-warn-orphans -rtsopts + + GHC-Options: -Wall -O2 -Wno-orphans -rtsopts if flag(threaded) - GHC-Options: -threaded + GHC-Options: -threaded -with-rtsopts=-qg + Hs-Source-Dirs: benchmarks Other-Extensions: BangPatterns - if flag(sync) - Buildable: True - else - Buildable: False - Build-Depends: base , async >= 2.0 && < 2.3 - , atomic-primops == 0.8.* , criterion >= 1.2 && < 1.6 , deepseq >= 1.1 && < 1.5 , stm >= 2.4 && < 2.6 +Benchmark sync + Import: concurrent-benchmarks + Type: exitcode-stdio-1.0 + Main-Is: Sync.hs + if flag(sync) + Buildable: True + else + Buildable: False + + Build-Depends: atomic-primops == 0.8.* + Benchmark channels - Default-Language: Haskell2010 + Import: concurrent-benchmarks Type: exitcode-stdio-1.0 Main-Is: Channels.hs - GHC-Options: -Wall -O2 -fno-warn-orphans -fno-warn-unused-do-bind - -fno-warn-type-defaults -rtsopts - if flag(threaded) - GHC-Options: -threaded - - Hs-Source-Dirs: benchmarks + GHC-Options: -Wno-unused-do-bind -Wno-type-defaults - Other-Extensions: BangPatterns - DeriveGeneric + Other-Extensions: DeriveGeneric RecordWildCards - Build-Depends: base - , broadcast-chan - , async >= 2.0 && < 2.3 - , criterion >= 1.2 && < 1.6 - , deepseq >= 1.1 && < 1.5 - , stm >= 2.4 && < 2.6 + Build-Depends: broadcast-chan Benchmark utilities Default-Language: Haskell2010 Type: exitcode-stdio-1.0 Main-Is: Utils.hs - GHC-Options: -Wall -O2 -fno-warn-orphans -fno-warn-unused-do-bind + GHC-Options: -Wall -O2 -Wno-orphans -Wno-unused-do-bind -rtsopts if flag(threaded) - GHC-Options: -threaded + GHC-Options: -threaded -with-rtsopts=-qg Hs-Source-Dirs: benchmarks Build-Depends: base