packages feed

stm-chans 1.3.1 → 3.0.0.11

raw patch · 16 files changed

Files

AUTHORS view
@@ -1,9 +1,13 @@ === Haskell stm-chans package AUTHORS/THANKS file === -The stm-chans package was written (predominantly) by wren ng thornton-and is released under the terms in the LICENSE file. Some important-improvements to TBChan and TBMChan were contributed by Thomas-DuBuisson, incorporating parts of his bounded-tchan package. These-improvements reduce contention between readers and writers, improving-throughput by 2--3 times when producers and consumers are running-in separate OS threads.+The stm-chans package was written (predominantly) by wren gayle romano+and is released under the terms in the LICENSE file. I would also+like to give thanks to the following contributors:++Thomas DuBuisson --- For important improvements to TBChan and+    TBMChan, incorporating parts of his bounded-tchan package. These+    improvements reduce contention between readers and writers,+    improving throughput by 2--3 times when producers and consumers+    are running in separate OS threads.++kudah --- For adding TQueue support.
+ CHANGELOG view
@@ -0,0 +1,60 @@+3.0.0.11 (2026-02-26):+    - Updating the `Tested-With` field for ghc 9.14 (didn't actually need to+      nudge the upper bound on 'base', because it's already lenient)+    - Also silencing some warnings on ghc >=9.12 about deriving Typeable.+3.0.0.10 (2024-08-28):+    - Updating the `Tested-With` field for ghc 9.10 (didn't actually need to+      nudge the upper bound on 'base', because it's already lenient)+3.0.0.9 (2023-03-19):+    - Added `Tested-With: GHC == 9.6.1` (didn't actually need to+      nudge the upper bound on 'base', because it's already lenient)+3.0.0.8 (2022-08-28):+    - Added `Tested-With: GHC == 9.4.1` (didn't actually need to+      nudge the upper bound on 'base', because it's already lenient)+3.0.0.7 (2021-11-22):+    - Added `Tested-With: GHC == 9.2.1` (didn't actually need to+      nudge the upper bound on 'base', because it's already lenient)+3.0.0.6 (2021-10-17):+    - Removed old __HADDOCK__ hack+    - Updating stale emails, urls, etc+3.0.0.5 (2021-10-16):+    - Fixed the cabal file for Cabal >1.24+3.0.0.4 (2015-05-30):+    - Moved VERSION to CHANGELOG+3.0.0.3 (2015-03-29):+    - Cleaning up headers to compile cleanly with GHC 7.10+3.0.0 (2013-05-29):+    - Removed the deprecated compatibility modules.++2.1.0 (2013-05-29):+    - Added UNPACK pragmas everywhere to reduce indirections.+    - Added versions of newBroadcastT*Chan for TMChan+    - Deprecated all the compatibility stuff, since newBroadcastTChan requires stm >= 2.4 anyways.+2.0.0 (2013-05-12):+    - Add TQueue support++1.3.1 (2012-02-29):+    - Corrected the CPP macros now that stm-2.3 is released.+1.3.0 (2012-02-25):+    - Added Control.Concurrent.STM.TMVar.Compat+1.2.0.3 (2012-02-12):+    - Change stability from experimental to provisional.+1.2.0.2 (2012-02-12):+    - Documentation fix for Control.Concurrent.STM.TMChan.writeTMChan+1.2.0.1 (2011-05-07):+    - Moved old TBChan,TBMChan implementations to ./test/bench/+1.2.0 (2011-05-07):+    - Various optimizations.+    - Switched to using 2 TVars in TBChan and TBMChan, reducing+      contention between readers and writers and improving throughput+      considerably (when multiple OS threads are used).+    - Control.Concurrent.STM.TBChan: added estimateFreeSlotsTBChan,+      freeSlotsTBChan+    - Control.Concurrent.STM.TBMChan: added estimateFreeSlotsTBMChan,+      freeSlotsTBMChan+1.1.0 (2011-04-05):+    - Control.Concurrent.STM.TBChan: added tryWriteTBChan+    - Control.Concurrent.STM.TBMChan: added tryWriteTBMChan+1.0.0 (2011-04-03):+    - Initial version forked from Posta-IPC.+    - Added tryRead* and tryPeek* functions for the various channels.
LICENSE view
@@ -1,6 +1,6 @@ === stm-chans license === -Copyright (c) 2011, 2012, wren ng thornton.+Copyright (c) 2011--2013, wren gayle romano. ALL RIGHTS RESERVED.  Redistribution and use in source and binary forms, with or without
− README 
@@ -1,20 +0,0 @@-stm-chans-=========--In general, this is a simple package and should be easy to install.-It does require GHC however, because it relies on the-Control.Concurrent.STM.TChan type which (for some unknown reason)-is GHC-only. With the cabal-install program you can just do:--    $> cabal install stm-chans--Or if you don't have cabal-install, then you can use the Cabal-library:--    $> runhaskell Setup.hs configure-    $> runhaskell Setup.hs build-    $> runhaskell Setup.hs test-    $> runhaskell Setup.hs haddock --hyperlink-source-    $> runhaskell Setup.hs install------------------------------------------------------------- fin.
+ README.md view
@@ -0,0 +1,43 @@+stm-chans+=========+[![CI Status](https://github.com/wrengr/stm-chans/actions/workflows/ci.yml/badge.svg)](https://github.com/wrengr/stm-chans/actions?query=workflow%3Aci+-event%3Apull_request)+[![Hackage version](https://img.shields.io/hackage/v/stm-chans.svg?style=flat)](https://hackage.haskell.org/package/stm-chans) +[![Stackage LTS version](https://stackage.org/package/stm-chans/badge/lts)](https://stackage.org/lts/package/stm-chans)+[![Stackage Nightly version](https://stackage.org/package/stm-chans/badge/nightly)](https://stackage.org/nightly/package/stm-chans)++This package offers a collection of channel types, similar to+`Control.Concurrent.STM.{TChan,TQueue}` but with additional features.+In particular we offer the following data types:++* `Control.Concurrent.STM.TBChan`:  Bounded FIFO channels.+    When the channel is full, writers will block/retry. This ensures+    that the writers do not get too far ahead of the readers, which+    helps to  make sure that memory and cpu resources are used+    responsibly.+* `Control.Concurrent.STM.TMChan`:   Closeable FIFO channels.+* `Control.Concurrent.STM.TMQueue`:  Closeable FIFO queues.+    Like `TChan (Maybe a)` but with a monotonicity guarantee that+    once `Nothing` is returned all future reads will be `Nothing`+    as well.+* `Control.Concurrent.STM.TBMChan`:  Bounded Closeable FIFO channels.+* `Control.Concurrent.STM.TBMQueue`: Bounded Closeable FIFO queues.+    Combines the capabilities of `TBChan` and `TMChan`.+++## Install++In general, this is a simple package and should be easy to install.+It does require GHC however, because it relies on the+Control.Concurrent.STM.TChan type which (for some unknown reason)+is GHC-only. With the cabal-install program you can just do:++    $> cabal install stm-chans+++## Links++* [Website](http://wrengr.org/)+* [Blog](http://winterkoninkje.dreamwidth.org/)+* [Twitter](https://twitter.com/wrengr)+* [Hackage](http://hackage.haskell.org/package/stm-chans)+* [GitHub](https://github.com/wrengr/stm-chans)
Setup.hs view
@@ -1,27 +1,7 @@ #!/usr/bin/env runhaskell--- Cf. <http://www.mail-archive.com/haskell-cafe@haskell.org/msg59984.html>--- <http://www.haskell.org/pipermail/haskell-cafe/2008-December/051785.html> -{-# OPTIONS_GHC -Wall -fwarn-tabs -fno-warn-missing-signatures #-} module Main (main) where import Distribution.Simple-import Distribution.Simple.LocalBuildInfo (withPrograms)-import Distribution.Simple.Program        (userSpecifyArgs)----------------------------------------------------------------- --- | Define __HADDOCK__ when building documentation. main :: IO ()-main = defaultMainWithHooks-    $ simpleUserHooks `modify_haddockHook` \oldHH pkg lbi hooks flags -> do-        -        -- Call the old haddockHook with a modified LocalBuildInfo-        (\lbi' -> oldHH pkg lbi' hooks flags)-            $ lbi `modify_withPrograms` \oldWP ->-                userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] oldWP---modify_haddockHook  hooks f = hooks { haddockHook  = f (haddockHook  hooks) }-modify_withPrograms lbi   f = lbi   { withPrograms = f (withPrograms lbi)   }------------------------------------------------------------------------------------------------------------------------------ fin.+main  = defaultMain
− VERSION 
@@ -1,25 +0,0 @@-1.3.1 (2012-02-29):-    - Corrected the CPP macros now that stm-2.3 is released.-1.3.0 (2012-02-25):-    - Added Control.Concurrent.STM.TMVar.Compat-1.2.0.3 (2012-02-12):-    - Change stability from experimental to provisional.-1.2.0.2 (2012-02-12):-    - Documentation fix for Control.Concurrent.STM.TMChan.writeTMChan-1.2.0.1 (2011-05-07):-    - Moved old TBChan,TBMChan implementations to ./test/bench/-1.2.0 (2011-05-07):-    - Various optimizations.-    - Switched to using 2 TVars in TBChan and TBMChan, reducing-      contention between readers and writers and improving throughput-      considerably (when multiple OS threads are used).-    - Control.Concurrent.STM.TBChan: added estimateFreeSlotsTBChan,-      freeSlotsTBChan-    - Control.Concurrent.STM.TBMChan: added estimateFreeSlotsTBMChan,-      freeSlotsTBMChan-1.1.0 (2011-04-05):-    - Control.Concurrent.STM.TBChan: added tryWriteTBChan-    - Control.Concurrent.STM.TBMChan: added tryWriteTBMChan-1.0.0 (2011-04-03):-    - Initial version forked from Posta-IPC.-    - Added tryRead* and tryPeek* functions for the various channels.
src/Control/Concurrent/STM/TBChan.hs view
@@ -1,12 +1,21 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ < 912+-- ghc-9.12: "all types now auto-derive Typeable"+{-# LANGUAGE DeriveDataTypeable #-}+#endif++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Safe #-}+#endif -------------------------------------------------------------------                                                    2011.04.06+--                                                    2026-02-26 -- | -- Module      :  Control.Concurrent.STM.TBChan--- Copyright   :  Copyright (c) 2011--2012 wren ng thornton+-- Copyright   :  Copyright (c) 2011--2026 wren gayle romano -- License     :  BSD--- Maintainer  :  wren@community.haskell.org+-- Maintainer  :  wren@cpan.org -- Stability   :  provisional -- Portability :  non-portable (GHC STM, DeriveDataTypeable) --@@ -41,22 +50,23 @@     ) where  import Prelude           hiding (reads)+#if __GLASGOW_HASKELL__ < 912 import Data.Typeable     (Typeable)-import Control.Monad.STM (STM, retry)-import Control.Concurrent.STM.TVar.Compat-import Control.Concurrent.STM.TChan.Compat -- N.B., GHC only---- N.B., we need a Custom cabal build-type for this to work.-#ifdef __HADDOCK__-import Control.Monad.STM (atomically)-import System.IO.Unsafe  (unsafePerformIO) #endif+import Control.Monad.STM (STM, retry)+import Control.Concurrent.STM.TVar+import Control.Concurrent.STM.TChan -- N.B., GHC only ----------------------------------------------------------------  -- | @TBChan@ is an abstract type representing a bounded FIFO -- channel.-data TBChan a = TBChan !(TVar Int) !(TVar Int) !(TChan a)+data TBChan a = TBChan+    {-# UNPACK #-} !(TVar Int)+    {-# UNPACK #-} !(TVar Int)+    {-# UNPACK #-} !(TChan a)+#if __GLASGOW_HASKELL__ < 912     deriving (Typeable)+#endif -- The components are: -- * How many free slots we /know/ we have available. -- * How many slots have been freed up by successful reads since@@ -77,8 +87,9 @@   -- | @IO@ version of 'newTBChan'. This is useful for creating--- top-level @TBChan@s using 'unsafePerformIO', because using--- 'atomically' inside 'unsafePerformIO' isn't possible.+-- top-level @TBChan@s using 'System.IO.Unsafe.unsafePerformIO',+-- because using 'Control.Monad.STM.atomically' inside+-- 'System.IO.Unsafe.unsafePerformIO' isn't possible. newTBChanIO :: Int -> IO (TBChan a) newTBChanIO n = do     slots <- newTVarIO n@@ -186,15 +197,15 @@   -- | Returns @True@ if the supplied @TBChan@ is empty (i.e., has--- no elements). /N.B./, a @TBChan@ can be both ``empty'' and--- ``full'' at the same time, if the initial limit was non-positive.+-- no elements). /N.B./, a @TBChan@ can be both \"empty\" and+-- \"full\" at the same time, if the initial limit was non-positive. isEmptyTBChan :: TBChan a -> STM Bool isEmptyTBChan (TBChan _slots _reads chan) =     isEmptyTChan chan   -- | Returns @True@ if the supplied @TBChan@ is full (i.e., is over--- its limit). /N.B./, a @TBChan@ can be both ``empty'' and ``full''+-- its limit). /N.B./, a @TBChan@ can be both \"empty\" and \"full\" -- at the same time, if the initial limit was non-positive. /N.B./, -- a @TBChan@ may still be full after reading, if 'unGetTBChan' was -- used to go over the initial limit.
src/Control/Concurrent/STM/TBMChan.hs view
@@ -1,12 +1,21 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ < 912+-- ghc-9.12: "all types now auto-derive Typeable"+{-# LANGUAGE DeriveDataTypeable #-}+#endif++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Safe #-}+#endif -------------------------------------------------------------------                                                    2011.04.06+--                                                    2026-02-26 -- | -- Module      :  Control.Concurrent.STM.TBMChan--- Copyright   :  Copyright (c) 2011--2012 wren ng thornton+-- Copyright   :  Copyright (c) 2011--2026 wren gayle romano -- License     :  BSD--- Maintainer  :  wren@community.haskell.org+-- Maintainer  :  wren@cpan.org -- Stability   :  provisional -- Portability :  non-portable (GHC STM, DeriveDataTypeable) --@@ -46,23 +55,27 @@     ) where  import Prelude             hiding (reads)+#if __GLASGOW_HASKELL__ < 912 import Data.Typeable       (Typeable)+#endif+#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))-import Control.Monad.STM   (STM, retry)-import Control.Concurrent.STM.TVar.Compat-import Control.Concurrent.STM.TChan.Compat -- N.B., GHC only---- N.B., we need a Custom cabal build-type for this to work.-#ifdef __HADDOCK__-import Control.Monad.STM   (atomically)-import System.IO.Unsafe    (unsafePerformIO) #endif+import Control.Monad.STM   (STM, retry)+import Control.Concurrent.STM.TVar+import Control.Concurrent.STM.TChan -- N.B., GHC only ----------------------------------------------------------------  -- | @TBMChan@ is an abstract type representing a bounded closeable -- FIFO channel.-data TBMChan a = TBMChan !(TVar Bool) !(TVar Int) !(TVar Int) !(TChan a)+data TBMChan a = TBMChan+    {-# UNPACK #-} !(TVar Bool)+    {-# UNPACK #-} !(TVar Int)+    {-# UNPACK #-} !(TVar Int)+    {-# UNPACK #-} !(TChan a)+#if __GLASGOW_HASKELL__ < 912     deriving (Typeable)+#endif -- The components are: -- * Whether the channel has been closed. -- * How many free slots we /know/ we have available.@@ -85,8 +98,9 @@   -- | @IO@ version of 'newTBMChan'. This is useful for creating--- top-level @TBMChan@s using 'unsafePerformIO', because using--- 'atomically' inside 'unsafePerformIO' isn't possible.+-- top-level @TBMChan@s using 'System.IO.Unsafe.unsafePerformIO',+-- because using 'Control.Monad.STM.atomically' inside+-- 'System.IO.Unsafe.unsafePerformIO' isn't possible. newTBMChanIO :: Int -> IO (TBMChan a) newTBMChanIO n = do     closed <- newTVarIO False@@ -114,7 +128,7 @@             x <- readTChan chan             modifyTVar' reads (1 +)             return (Just x)-{- +{- -- The above is slightly optimized over the clearer: readTBMChan (TBMChan closed _slots reads chan) =     b  <- readTVar closed@@ -151,7 +165,7 @@                 Just _x -> do                     modifyTVar' reads (1 +)                     return (Just mx)-{- +{- -- The above is slightly optimized over the clearer: tryReadTBMChan (TBMChan closed _slots reads chan) =     b  <- readTVar closed@@ -186,7 +200,7 @@ peekTBMChan (TBMChan closed _slots _reads chan) = do     b  <- isEmptyTChan chan     b' <- readTVar closed-    if b && b' +    if b && b'         then return Nothing         else Just <$> peekTChan chan -- TODO: compare Core and benchmarks; is the loss of clarity worth it?@@ -208,7 +222,7 @@ tryPeekTBMChan (TBMChan closed _slots _reads chan) = do     b  <- isEmptyTChan chan     b' <- readTVar closed-    if b && b' +    if b && b'         then return Nothing         else Just <$> tryPeekTChan chan -- TODO: compare Core and benchmarks; is the loss of clarity worth it?@@ -288,16 +302,16 @@   -- | Returns @True@ if the supplied @TBMChan@ is empty (i.e., has--- no elements). /N.B./, a @TBMChan@ can be both ``empty'' and--- ``full'' at the same time, if the initial limit was non-positive.+-- no elements). /N.B./, a @TBMChan@ can be both \"empty\" and+-- \"full\" at the same time, if the initial limit was non-positive. isEmptyTBMChan :: TBMChan a -> STM Bool isEmptyTBMChan (TBMChan _closed _slots _reads chan) =     isEmptyTChan chan   -- | Returns @True@ if the supplied @TBMChan@ is full (i.e., is--- over its limit). /N.B./, a @TBMChan@ can be both ``empty'' and--- ``full'' at the same time, if the initial limit was non-positive.+-- over its limit). /N.B./, a @TBMChan@ can be both \"empty\" and+-- \"full\" at the same time, if the initial limit was non-positive. -- /N.B./, a @TBMChan@ may still be full after reading, if -- 'unGetTBMChan' was used to go over the initial limit. --
+ src/Control/Concurrent/STM/TBMQueue.hs view
@@ -0,0 +1,366 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ < 912+-- ghc-9.12: "all types now auto-derive Typeable"+{-# LANGUAGE DeriveDataTypeable #-}+#endif++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Safe #-}+#endif+----------------------------------------------------------------+--                                                    2026-02-26+-- |+-- Module      :  Control.Concurrent.STM.TBMQueue+-- Copyright   :  Copyright (c) 2011--2026 wren gayle romano+-- License     :  BSD+-- Maintainer  :  wren@cpan.org+-- Stability   :  provisional+-- Portability :  non-portable (GHC STM, DeriveDataTypeable)+--+-- A version of "Control.Concurrent.STM.TQueue" where the queue is+-- bounded in length and closeable. This combines the abilities of+-- "Control.Concurrent.STM.TBQueue" and "Control.Concurrent.STM.TMQueue".+--+-- /Since: 2.0.0/+----------------------------------------------------------------+module Control.Concurrent.STM.TBMQueue+    (+    -- * The TBMQueue type+      TBMQueue()+    -- ** Creating TBMQueues+    , newTBMQueue+    , newTBMQueueIO+    -- ** Reading from TBMQueues+    , readTBMQueue+    , tryReadTBMQueue+    , peekTBMQueue+    , tryPeekTBMQueue+    -- ** Writing to TBMQueues+    , writeTBMQueue+    , tryWriteTBMQueue+    , unGetTBMQueue+    -- ** Closing TBMQueues+    , closeTBMQueue+    -- ** Predicates+    , isClosedTBMQueue+    , isEmptyTBMQueue+    , isFullTBMQueue+    -- ** Other functionality+    , estimateFreeSlotsTBMQueue+    , freeSlotsTBMQueue+    ) where++import Prelude             hiding (reads)+#if __GLASGOW_HASKELL__ < 912+import Data.Typeable       (Typeable)+#endif+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif+import Control.Monad.STM   (STM, retry)+import Control.Concurrent.STM.TVar+import Control.Concurrent.STM.TQueue -- N.B., GHC only+----------------------------------------------------------------++-- | @TBMQueue@ is an abstract type representing a bounded closeable+-- FIFO queue.+data TBMQueue a = TBMQueue+    {-# UNPACK #-} !(TVar Bool)+    {-# UNPACK #-} !(TVar Int)+    {-# UNPACK #-} !(TVar Int)+    {-# UNPACK #-} !(TQueue a)+#if __GLASGOW_HASKELL__ < 912+    deriving (Typeable)+#endif+-- The components are:+-- * Whether the queue has been closed.+-- * How many free slots we /know/ we have available.+-- * How many slots have been freed up by successful reads since+--   the last time the slot count was synchronized by 'isFullTBQueue'.+-- * The underlying TQueue.+++-- | Build and returns a new instance of @TBMQueue@ with the given+-- capacity. /N.B./, we do not verify the capacity is positive, but+-- if it is non-positive then 'writeTBMQueue' will always retry and+-- 'isFullTBMQueue' will always be true.+newTBMQueue :: Int -> STM (TBMQueue a)+newTBMQueue n = do+    closed <- newTVar False+    slots  <- newTVar n+    reads  <- newTVar 0+    queue  <- newTQueue+    return (TBMQueue closed slots reads queue)+++-- | @IO@ version of 'newTBMQueue'. This is useful for creating+-- top-level @TBMQueue@s using 'System.IO.Unsafe.unsafePerformIO',+-- because using 'Control.Monad.STM.atomically' inside+-- 'System.IO.Unsafe.unsafePerformIO' isn't possible.+newTBMQueueIO :: Int -> IO (TBMQueue a)+newTBMQueueIO n = do+    closed <- newTVarIO False+    slots  <- newTVarIO n+    reads  <- newTVarIO 0+    queue  <- newTQueueIO+    return (TBMQueue closed slots reads queue)+++-- | Read the next value from the @TBMQueue@, retrying if the queue+-- is empty (and not closed). We return @Nothing@ immediately if+-- the queue is closed and empty.+readTBMQueue :: TBMQueue a -> STM (Maybe a)+readTBMQueue (TBMQueue closed _slots reads queue) = do+    b <- readTVar closed+    if b+        then do+            mx <- tryReadTQueue queue+            case mx of+                Nothing -> return mx+                Just _x -> do+                    modifyTVar' reads (1 +)+                    return mx+        else do+            x <- readTQueue queue+            modifyTVar' reads (1 +)+            return (Just x)+{-+-- The above is slightly optimized over the clearer:+readTBMQueue (TBMQueue closed _slots reads queue) =+    b  <- readTVar closed+    b' <- isEmptyTQueue queue+    if b && b'+        then return Nothing+        else do+            x <- readTQueue queue+            modifyTVar' reads (1 +)+            return (Just x)+-- TODO: compare Core and benchmarks; is the loss of clarity worth it?+-}+++-- | A version of 'readTBMQueue' which does not retry. Instead it+-- returns @Just Nothing@ if the queue is open but no value is+-- available; it still returns @Nothing@ if the queue is closed+-- and empty.+tryReadTBMQueue :: TBMQueue a -> STM (Maybe (Maybe a))+tryReadTBMQueue (TBMQueue closed _slots reads queue) = do+    b <- readTVar closed+    if b+        then do+            mx <- tryReadTQueue queue+            case mx of+                Nothing -> return Nothing+                Just _x -> do+                    modifyTVar' reads (1 +)+                    return (Just mx)+        else do+            mx <- tryReadTQueue queue+            case mx of+                Nothing -> return (Just mx)+                Just _x -> do+                    modifyTVar' reads (1 +)+                    return (Just mx)+{-+-- The above is slightly optimized over the clearer:+tryReadTBMQueue (TBMQueue closed _slots reads queue) =+    b  <- readTVar closed+    b' <- isEmptyTQueue queue+    if b && b'+        then return Nothing+        else do+            mx <- tryReadTBMQueue queue+            case mx of+                Nothing -> return (Just mx)+                Just _x -> do+                    modifyTVar' reads (1 +)+                    return (Just mx)+-- TODO: compare Core and benchmarks; is the loss of clarity worth it?+-}+++-- | Get the next value from the @TBMQueue@ without removing it,+-- retrying if the queue is empty.+peekTBMQueue :: TBMQueue a -> STM (Maybe a)+peekTBMQueue (TBMQueue closed _slots _reads queue) = do+    b <- readTVar closed+    if b+        then do+            b' <- isEmptyTQueue queue+            if b'+                then return Nothing+                else Just <$> peekTQueue queue+        else Just <$> peekTQueue queue+{-+-- The above is lazier reading from @queue@ than the clearer:+peekTBMQueue (TBMQueue closed _slots _reads queue) = do+    b  <- isEmptyTQueue queue+    b' <- readTVar closed+    if b && b'+        then return Nothing+        else Just <$> peekTQueue queue+-- TODO: compare Core and benchmarks; is the loss of clarity worth it?+-}+++-- | A version of 'peekTBMQueue' which does not retry. Instead it+-- returns @Just Nothing@ if the queue is open but no value is+-- available; it still returns @Nothing@ if the queue is closed+-- and empty.+tryPeekTBMQueue :: TBMQueue a -> STM (Maybe (Maybe a))+tryPeekTBMQueue (TBMQueue closed _slots _reads queue) = do+    b <- readTVar closed+    if b+        then fmap Just <$> tryPeekTQueue queue+        else Just <$> tryPeekTQueue queue+{-+-- The above is lazier reading from @queue@ (and removes an extraneous isEmptyTQueue when using the compatibility layer) than the clearer:+tryPeekTBMQueue (TBMQueue closed _slots _reads queue) = do+    b  <- isEmptyTQueue queue+    b' <- readTVar closed+    if b && b'+        then return Nothing+        else Just <$> tryPeekTQueue queue+-- TODO: compare Core and benchmarks; is the loss of clarity worth it?+-}+++-- | Write a value to a @TBMQueue@, retrying if the queue is full.+-- If the queue is closed then the value is silently discarded.+-- Use 'isClosedTBMQueue' to determine if the queue is closed+-- before writing, as needed.+writeTBMQueue :: TBMQueue a -> a -> STM ()+writeTBMQueue self@(TBMQueue closed slots _reads queue) x = do+    b <- readTVar closed+    if b+        then return () -- Discard silently+        else do+            n <- estimateFreeSlotsTBMQueue self+            if n <= 0+                then retry+                else do+                    writeTVar slots $! n - 1+                    writeTQueue queue x+++-- | A version of 'writeTBMQueue' which does not retry. Returns @Just+-- True@ if the value was successfully written, @Just False@ if it+-- could not be written (but the queue was open), and @Nothing@+-- if it was discarded (i.e., the queue was closed).+tryWriteTBMQueue :: TBMQueue a -> a -> STM (Maybe Bool)+tryWriteTBMQueue self@(TBMQueue closed slots _reads queue) x = do+    b <- readTVar closed+    if b+        then return Nothing+        else do+            n <- estimateFreeSlotsTBMQueue self+            if n <= 0+                then return (Just False)+                else do+                    writeTVar slots $! n - 1+                    writeTQueue queue x+                    return (Just True)+++-- | Put a data item back onto a queue, where it will be the next+-- item read. If the queue is closed then the value is silently+-- discarded; you can use 'peekTBMQueue' to circumvent this in certain+-- circumstances. /N.B./, this could allow the queue to temporarily+-- become longer than the specified limit, which is necessary to+-- ensure that the item is indeed the next one read.+unGetTBMQueue :: TBMQueue a -> a -> STM ()+unGetTBMQueue (TBMQueue closed slots _reads queue) x = do+    b <- readTVar closed+    if b+        then return () -- Discard silently+        else do+            modifyTVar' slots (subtract 1)+            unGetTQueue queue x+++-- | Closes the @TBMQueue@, preventing any further writes.+closeTBMQueue :: TBMQueue a -> STM ()+closeTBMQueue (TBMQueue closed _slots _reads _queue) =+    writeTVar closed True+++-- | Returns @True@ if the supplied @TBMQueue@ has been closed.+isClosedTBMQueue :: TBMQueue a -> STM Bool+isClosedTBMQueue (TBMQueue closed _slots _reads _queue) =+    readTVar closed++{-+-- | Returns @True@ if the supplied @TBMQueue@ has been closed.+isClosedTBMQueueIO :: TBMQueue a -> IO Bool+isClosedTBMQueueIO (TBMQueue closed _slots _reads _queue) =+    readTVarIO closed+-}+++-- | Returns @True@ if the supplied @TBMQueue@ is empty (i.e., has+-- no elements). /N.B./, a @TBMQueue@ can be both \"empty\" and+-- \"full\" at the same time, if the initial limit was non-positive.+isEmptyTBMQueue :: TBMQueue a -> STM Bool+isEmptyTBMQueue (TBMQueue _closed _slots _reads queue) =+    isEmptyTQueue queue+++-- | Returns @True@ if the supplied @TBMQueue@ is full (i.e., is+-- over its limit). /N.B./, a @TBMQueue@ can be both \"empty\" and+-- \"full\" at the same time, if the initial limit was non-positive.+-- /N.B./, a @TBMQueue@ may still be full after reading, if+-- 'unGetTBMQueue' was used to go over the initial limit.+--+-- This is equivalent to: @liftM (<= 0) estimateFreeSlotsTBMQueue@+isFullTBMQueue :: TBMQueue a -> STM Bool+isFullTBMQueue (TBMQueue _closed slots reads _queue) = do+    n <- readTVar slots+    if n <= 0+        then do+            m <- readTVar reads+            let n' = n + m+            writeTVar slots $! n'+            writeTVar reads 0+            return $! n' <= 0+        else return False+++-- | Estimate the number of free slots. If the result is positive,+-- then it's a minimum bound; if it's non-positive then it's exact.+-- It will only be negative if the initial limit was negative or+-- if 'unGetTBMQueue' was used to go over the initial limit.+--+-- This function always contends with writers, but only contends+-- with readers when it has to; compare against 'freeSlotsTBMQueue'.+estimateFreeSlotsTBMQueue :: TBMQueue a -> STM Int+estimateFreeSlotsTBMQueue (TBMQueue _closed slots reads _queue) = do+    n <- readTVar slots+    if n > 0+        then return n+        else do+            m <- readTVar reads+            let n' = n + m+            writeTVar slots $! n'+            writeTVar reads 0+            return n'+++-- | Return the exact number of free slots. The result can be+-- negative if the initial limit was negative or if 'unGetTBMQueue'+-- was used to go over the initial limit.+--+-- This function always contends with both readers and writers;+-- compare against 'estimateFreeSlotsTBMQueue'.+freeSlotsTBMQueue :: TBMQueue a -> STM Int+freeSlotsTBMQueue (TBMQueue _closed slots reads _queue) = do+    n <- readTVar slots+    m <- readTVar reads+    let n' = n + m+    writeTVar slots $! n'+    writeTVar reads 0+    return n'++----------------------------------------------------------------+----------------------------------------------------------- fin.
− src/Control/Concurrent/STM/TChan/Compat.hs 
@@ -1,98 +0,0 @@-{-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE CPP #-}--------------------------------------------------------------------                                                    2012.02.29--- |--- Module      :  Control.Concurrent.STM.TChan.Compat--- Copyright   :  Copyright (c) 2011--2012 wren ng thornton--- License     :  BSD--- Maintainer  :  wren@community.haskell.org--- Stability   :  provisional--- Portability :  non-portable (GHC STM, CPP)------ Compatibility layer for older versions of the @stm@ library.--- Namely, we define 'tryReadTChan', 'peekTChan', and 'tryPeekTChan'--- which @stm<2.3.0@ lacks. These implementations are less efficient--- than the package versions due to the 'TChan' type being abstract.--- However, this module uses Cabal-style CPP macros in order to use--- the package versions when available.------------------------------------------------------------------module Control.Concurrent.STM.TChan.Compat-    (-    -- * The TChan type-      TChan-    -- ** Creating TChans-    , newTChan     -- :: STM (TChan a)-    , newTChanIO   -- :: IO  (TChan a)-    , dupTChan     -- :: TChan a -> STM (TChan a)-    -- ** Reading from TChans-    , readTChan    -- :: TChan a -> STM a-    , tryReadTChan -- :: TChan a -> STM (Maybe a)-    , peekTChan    -- :: TChan a -> STM a-    , tryPeekTChan -- :: TChan a -> STM (Maybe a)-    -- ** Writing to TChans-    , unGetTChan   -- :: TChan a -> a -> STM ()-    , writeTChan   -- :: TChan a -> a -> STM ()-    -- ** Predicates-    , isEmptyTChan -- :: TChan a -> STM Bool-    ) where--import Control.Concurrent.STM.TChan -- N.B., GHC only--#if ! (MIN_VERSION_stm(2,3,0))-import Control.Applicative ((<$>))-import Control.Monad.STM   (STM)---------------------------------------------------------------------- | A version of 'readTChan' which does not retry. Instead it--- returns @Nothing@ if no value is available.-tryReadTChan :: TChan a -> STM (Maybe a)-tryReadTChan chan = do-    b <- isEmptyTChan chan-    if b then return Nothing else Just <$> readTChan chan-{- -- The optimized implementation in stm-2.3.0-tryReadTChan (TChan read _write) = do-    hd <- readTVar =<< readTVar read-    case hd of-        TNil       -> return Nothing-        TCons a tl -> do-            writeTVar read tl-            return (Just a)--}----- | Get the next value from the @TChan@ without removing it,--- retrying if the channel is empty.-peekTChan :: TChan a -> STM a-peekTChan chan = do-    x <- readTChan chan-    unGetTChan chan x-    return x-{- -- The optimized implementation in stm-2.3.0-peekTChan (TChan read _write) = do-    hd <- readTVar =<< readTVar read-    case hd of-        TNil      -> retry-        TCons a _ -> return a--}----- | A version of 'peekTChan' which does not retry. Instead it--- returns @Nothing@ if no value is available.-tryPeekTChan :: TChan a -> STM (Maybe a)-tryPeekTChan chan = do-    b <- isEmptyTChan chan-    if b then return Nothing else Just <$> peekTChan chan-{- -- The optimized implementation in stm-2.3.0-tryPeekTChan (TChan read _write) = do-    hd <- readTVar =<< readTVar read-    case hd of-        TNil      -> return Nothing-        TCons a _ -> return (Just a)--}--#endif------------------------------------------------------------------------------------------------------------------------------ fin.
src/Control/Concurrent/STM/TMChan.hs view
@@ -1,12 +1,21 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ < 912+-- ghc-9.12: "all types now auto-derive Typeable"+{-# LANGUAGE DeriveDataTypeable #-}+#endif++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Safe #-}+#endif -------------------------------------------------------------------                                                    2012.02.12+--                                                    2026-02-26 -- | -- Module      :  Control.Concurrent.STM.TMChan--- Copyright   :  Copyright (c) 2011--2012 wren ng thornton+-- Copyright   :  Copyright (c) 2011--2026 wren gayle romano -- License     :  BSD--- Maintainer  :  wren@community.haskell.org+-- Maintainer  :  wren@cpan.org -- Stability   :  provisional -- Portability :  non-portable (GHC STM, DeriveDataTypeable) --@@ -23,6 +32,8 @@     , newTMChan     , newTMChanIO     , dupTMChan+    , newBroadcastTMChan+    , newBroadcastTMChanIO     -- ** Reading from TMChans     , readTMChan     , tryReadTMChan@@ -38,23 +49,25 @@     , isEmptyTMChan     ) where +#if __GLASGOW_HASKELL__ < 912 import Data.Typeable       (Typeable)+#endif+#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>))-import Control.Monad.STM   (STM)-import Control.Concurrent.STM.TVar.Compat-import Control.Concurrent.STM.TChan.Compat -- N.B., GHC only---- N.B., we need a Custom cabal build-type for this to work.-#ifdef __HADDOCK__-import Control.Monad.STM   (atomically)-import System.IO.Unsafe    (unsafePerformIO) #endif+import Control.Monad.STM   (STM)+import Control.Concurrent.STM.TVar+import Control.Concurrent.STM.TChan -- N.B., GHC only ----------------------------------------------------------------  -- | @TMChan@ is an abstract type representing a closeable FIFO -- channel.-data TMChan a = TMChan !(TVar Bool) !(TChan a)+data TMChan a = TMChan+    {-# UNPACK #-} !(TVar Bool)+    {-# UNPACK #-} !(TChan a)+#if __GLASGOW_HASKELL__ < 912     deriving Typeable+#endif   -- | Build and returns a new instance of @TMChan@.@@ -66,8 +79,9 @@   -- | @IO@ version of 'newTMChan'. This is useful for creating--- top-level @TMChan@s using 'unsafePerformIO', because using--- 'atomically' inside 'unsafePerformIO' isn't possible.+-- top-level @TMChan@s using 'System.IO.Unsafe.unsafePerformIO',+-- because using 'Control.Monad.STM.atomically' inside+-- 'System.IO.Unsafe.unsafePerformIO' isn't possible. newTMChanIO :: IO (TMChan a) newTMChanIO = do     closed <- newTVarIO False@@ -75,6 +89,26 @@     return (TMChan closed chan)  +-- | Like 'newBroadcastTChan'.+--+-- /Since: 2.1.0/+newBroadcastTMChan :: STM (TMChan a)+newBroadcastTMChan = do+    closed <- newTVar False+    chan   <- newBroadcastTChan+    return (TMChan closed chan)+++-- | @IO@ version of 'newBroadcastTMChan'.+--+-- /Since: 2.1.0/+newBroadcastTMChanIO :: IO (TMChan a)+newBroadcastTMChanIO = do+    closed <- newTVarIO False+    chan   <- newBroadcastTChanIO+    return (TMChan closed chan)++ -- | Duplicate a @TMChan@: the duplicate channel begins empty, but -- data written to either channel from then on will be available -- from both, and closing one copy will close them all. Hence this@@ -146,7 +180,7 @@ peekTMChan (TMChan closed chan) = do     b  <- isEmptyTChan chan     b' <- readTVar closed-    if b && b' +    if b && b'         then return Nothing         else Just <$> peekTChan chan -- TODO: compare Core and benchmarks; is the loss of clarity worth it?@@ -168,7 +202,7 @@ tryPeekTMChan (TMChan closed chan) = do     b  <- isEmptyTChan chan     b' <- readTVar closed-    if b && b' +    if b && b'         then return Nothing         else Just <$> tryPeekTChan chan -- TODO: compare Core and benchmarks; is the loss of clarity worth it?
+ src/Control/Concurrent/STM/TMQueue.hs view
@@ -0,0 +1,228 @@+{-# OPTIONS_GHC -Wall -fwarn-tabs #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ < 912+-- ghc-9.12: "all types now auto-derive Typeable"+{-# LANGUAGE DeriveDataTypeable #-}+#endif++#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Safe #-}+#endif+----------------------------------------------------------------+--                                                    2026-02-26+-- |+-- Module      :  Control.Concurrent.STM.TMQueue+-- Copyright   :  Copyright (c) 2011--2026 wren gayle romano+-- License     :  BSD+-- Maintainer  :  wren@cpan.org+-- Stability   :  provisional+-- Portability :  non-portable (GHC STM, DeriveDataTypeable)+--+-- A version of "Control.Concurrent.STM.TQueue" where the queue is+-- closeable. This is similar to a @TQueue (Maybe a)@ with a+-- monotonicity guarantee that once there's a @Nothing@ there will+-- always be @Nothing@.+--+-- /Since: 2.0.0/+----------------------------------------------------------------+module Control.Concurrent.STM.TMQueue+    (+    -- * The TMQueue type+      TMQueue()+    -- ** Creating TMQueues+    , newTMQueue+    , newTMQueueIO+    -- ** Reading from TMQueues+    , readTMQueue+    , tryReadTMQueue+    , peekTMQueue+    , tryPeekTMQueue+    -- ** Writing to TMQueues+    , writeTMQueue+    , unGetTMQueue+    -- ** Closing TMQueues+    , closeTMQueue+    -- ** Predicates+    , isClosedTMQueue+    , isEmptyTMQueue+    ) where++#if __GLASGOW_HASKELL__ < 912+import Data.Typeable       (Typeable)+#endif+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif+import Control.Monad.STM   (STM)+import Control.Concurrent.STM.TVar+import Control.Concurrent.STM.TQueue -- N.B., GHC only+----------------------------------------------------------------++-- | @TMQueue@ is an abstract type representing a closeable FIFO+-- queue.+data TMQueue a = TMQueue+    {-# UNPACK #-} !(TVar Bool)+    {-# UNPACK #-} !(TQueue a)+#if __GLASGOW_HASKELL__ < 912+    deriving Typeable+#endif+++-- | Build and returns a new instance of @TMQueue@.+newTMQueue :: STM (TMQueue a)+newTMQueue = do+    closed <- newTVar False+    queue  <- newTQueue+    return (TMQueue closed queue)+++-- | @IO@ version of 'newTMQueue'. This is useful for creating+-- top-level @TMQueue@s using 'System.IO.Unsafe.unsafePerformIO',+-- because using 'Control.Monad.STM.atomically' inside+-- 'System.IO.Unsafe.unsafePerformIO' isn't possible.+newTMQueueIO :: IO (TMQueue a)+newTMQueueIO = do+    closed <- newTVarIO False+    queue  <- newTQueueIO+    return (TMQueue closed queue)+++-- | Read the next value from the @TMQueue@, retrying if the queue+-- is empty (and not closed). We return @Nothing@ immediately if+-- the queue is closed and empty.+readTMQueue :: TMQueue a -> STM (Maybe a)+readTMQueue (TMQueue closed queue) = do+    b <- readTVar closed+    if b+        then tryReadTQueue queue+        else Just <$> readTQueue queue+{-+-- The above is lazier reading from @queue@, and slightly optimized, compared to the clearer:+readTMQueue (TMQueue closed queue) = do+    b  <- isEmptyTQueue queue+    b' <- readTVar closed+    if b && b'+        then return Nothing+        else Just <$> readTQueue queue+-- TODO: compare Core and benchmarks; is the loss of clarity worth it?+-}+++-- | A version of 'readTMQueue' which does not retry. Instead it+-- returns @Just Nothing@ if the queue is open but no value is+-- available; it still returns @Nothing@ if the queue is closed+-- and empty.+tryReadTMQueue :: TMQueue a -> STM (Maybe (Maybe a))+tryReadTMQueue (TMQueue closed queue) = do+    b <- readTVar closed+    if b+        then fmap Just <$> tryReadTQueue queue+        else Just <$> tryReadTQueue queue+{-+-- The above is lazier reading from @queue@ (and removes an extraneous isEmptyTQueue when using the compatibility layer) than the clearer:+tryReadTMQueue (TMQueue closed queue) = do+    b  <- isEmptyTQueue queue+    b' <- readTVar closed+    if b && b'+        then return Nothing+        else Just <$> tryReadTQueue queue+-- TODO: compare Core and benchmarks; is the loss of clarity worth it?+-}+++-- | Get the next value from the @TMQueue@ without removing it,+-- retrying if the queue is empty.+peekTMQueue :: TMQueue a -> STM (Maybe a)+peekTMQueue (TMQueue closed queue) = do+    b <- readTVar closed+    if b+        then do+            b' <- isEmptyTQueue queue+            if b'+                then return Nothing+                else Just <$> peekTQueue queue+        else Just <$> peekTQueue queue+{-+-- The above is lazier reading from @queue@ than the clearer:+peekTMQueue (TMQueue closed queue) = do+    b  <- isEmptyTQueue queue+    b' <- readTVar closed+    if b && b'+        then return Nothing+        else Just <$> peekTQueue queue+-- TODO: compare Core and benchmarks; is the loss of clarity worth it?+-}+++-- | A version of 'peekTMQueue' which does not retry. Instead it+-- returns @Just Nothing@ if the queue is open but no value is+-- available; it still returns @Nothing@ if the queue is closed+-- and empty.+tryPeekTMQueue :: TMQueue a -> STM (Maybe (Maybe a))+tryPeekTMQueue (TMQueue closed queue) = do+    b <- readTVar closed+    if b+        then fmap Just <$> tryPeekTQueue queue+        else Just <$> tryPeekTQueue queue+{-+-- The above is lazier reading from @queue@ (and removes an extraneous isEmptyTQueue when using the compatibility layer) than the clearer:+tryPeekTMQueue (TMQueue closed queue) = do+    b  <- isEmptyTQueue queue+    b' <- readTVar closed+    if b && b'+        then return Nothing+        else Just <$> tryPeekTQueue queue+-- TODO: compare Core and benchmarks; is the loss of clarity worth it?+-}+++-- | Write a value to a @TMQueue@. If the queue is closed then the+-- value is silently discarded. Use 'isClosedTMQueue' to determine+-- if the queue is closed before writing, as needed.+writeTMQueue :: TMQueue a -> a -> STM ()+writeTMQueue (TMQueue closed queue) x = do+    b <- readTVar closed+    if b+        then return () -- discard silently+        else writeTQueue queue x+++-- | Put a data item back onto a queue, where it will be the next+-- item read. If the queue is closed then the value is silently+-- discarded; you can use 'peekTMQueue' to circumvent this in certain+-- circumstances.+unGetTMQueue :: TMQueue a -> a -> STM ()+unGetTMQueue (TMQueue closed queue) x = do+    b <- readTVar closed+    if b+        then return () -- discard silently+        else unGetTQueue queue x+++-- | Closes the @TMQueue@, preventing any further writes.+closeTMQueue :: TMQueue a -> STM ()+closeTMQueue (TMQueue closed _queue) =+    writeTVar closed True+++-- | Returns @True@ if the supplied @TMQueue@ has been closed.+isClosedTMQueue :: TMQueue a -> STM Bool+isClosedTMQueue (TMQueue closed _queue) =+    readTVar closed++{-+-- | Returns @True@ if the supplied @TMQueue@ has been closed.+isClosedTMQueueIO :: TMQueue a -> IO Bool+isClosedTMQueueIO (TMQueue closed _queue) =+    readTVarIO closed+-}+++-- | Returns @True@ if the supplied @TMQueue@ is empty.+isEmptyTMQueue :: TMQueue a -> STM Bool+isEmptyTMQueue (TMQueue _closed queue) =+    isEmptyTQueue queue++----------------------------------------------------------------+----------------------------------------------------------- fin.
− src/Control/Concurrent/STM/TMVar/Compat.hs 
@@ -1,67 +0,0 @@-{-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE CPP #-}--------------------------------------------------------------------                                                    2012.02.29--- |--- Module      :  Control.Concurrent.STM.TMVar.Compat--- Copyright   :  Copyright (c) 2011--2012 wren ng thornton--- License     :  BSD--- Maintainer  :  wren@community.haskell.org--- Stability   :  provisional--- Portability :  non-portable (STM, CPP)------ Compatibility layer for older versions of the @stm@ library.--- Namely, we define 'tryReadTMVar' which @stm<2.3.0@ lacks. This--- module uses Cabal-style CPP macros in order to use the package--- versions when available. This isn't actually used by the @stm-chans@--- package, but we provide it anyways since we provide compatibility--- layers for @TVar@ and @TChan@.------ /Since: 1.3.0/------------------------------------------------------------------module Control.Concurrent.STM.TMVar.Compat-    (-    -- * The TMVar type-      TMVar()-    -- ** Creating TMVars-    , newTMVar        -- :: a -> STM (TMVar a)-    , newTMVarIO      -- :: a -> IO  (TMVar a)-    , newEmptyTMVar   -- :: STM (TMVar a)-    , newEmptyTMVarIO -- :: IO  (TMVar a)-    -- ** Reading from TMVars-    , readTMVar       -- :: TMVar a -> STM a-    , tryReadTMVar    -- :: TMVar a -> STM (Maybe a)-    , takeTMVar       -- :: TMVar a -> STM a-    , tryTakeTMVar    -- :: TMVar a -> STM (Maybe a)-    -- ** Writing to TMVars-    , putTMVar        -- :: TMVar a -> a -> STM ()-    , tryPutTMVar     -- :: TMVar a -> a -> STM Bool-    , swapTMVar       -- :: TMVar a -> a -> STM a-    -- TODO: make another patch for trySwapTMVar?-    -- ** Other capabilities-    , isEmptyTMVar    -- :: TMVar a -> STM Bool-    ) where--import Control.Concurrent.STM.TMVar--#if ! (MIN_VERSION_stm(2,3,0))-import Control.Concurrent.STM (STM)--------------------------------------------------------------------- | A version of 'readTMVar' which does not retry. Instead it--- returns @Nothing@ if no value is available.-tryReadTMVar :: TMVar a -> STM (Maybe a)-tryReadTMVar var = do-    m <- tryTakeTMVar var-    case m of-        Nothing -> return Nothing-        Just x  -> putTMVar var x >> return (Just x)-{- -- The optimized implementation in stm-2.3.0-tryReadTMVar (TMVar t) = readTVar t-{-# INLINE tryReadTMVar #-}--}--#endif------------------------------------------------------------------------------------------------------------------------------ fin.
− src/Control/Concurrent/STM/TVar/Compat.hs 
@@ -1,95 +0,0 @@-{-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE CPP #-}--------------------------------------------------------------------                                                    2012.02.29--- |--- Module      :  Control.Concurrent.STM.TVar.Compat--- Copyright   :  Copyright (c) 2011--2012 wren ng thornton--- License     :  BSD--- Maintainer  :  wren@community.haskell.org--- Stability   :  provisional--- Portability :  non-portable (STM, CPP)------ Compatibility layer for older versions of the @stm@ library.--- Namely, we define 'readTVarIO' which @stm<2.1.2@ lacks; and we--- define 'modifyTVar', 'modifyTVar'', and 'swapTVar' which @stm<2.3.0@--- lacks. This module uses Cabal-style CPP macros in order to use--- the package versions when available.------------------------------------------------------------------module Control.Concurrent.STM.TVar.Compat-    (-    -- * The TVar type-      TVar()-    -- ** Creating TVars-    , newTVar       -- :: a -> STM (TVar a)-    , newTVarIO     -- :: a -> IO  (TVar a)-    -- ** Reading from TVars-    , readTVar      -- :: TVar a -> STM a-    , readTVarIO    -- :: TVar a -> IO  a-    -- ** Writing to TVars-    , writeTVar     -- :: TVar a -> a -> STM ()-    , modifyTVar    -- :: TVar a -> (a -> a) -> STM ()-    , modifyTVar'   -- :: TVar a -> (a -> a) -> STM ()-    , swapTVar      -- :: TVar a -> a -> STM a-    -- ** Other capabilities-    , registerDelay -- :: Int -> IO (TVar Bool)-    ) where--import Control.Concurrent.STM.TVar--#if ! (MIN_VERSION_stm(2,1,2))-import Control.Concurrent.STM (atomically)-#endif--#if ! (MIN_VERSION_stm(2,3,0))-import Control.Concurrent.STM (STM)-#endif-------------------------------------------------------------------#if ! (MIN_VERSION_stm(2,1,2))--- | Return the current value stored in a TVar. This is equivalent to------ > readTVarIO = atomically . readTVar------ but works much faster (on @stm >= 2.1.2@), because it doesn't--- perform a complete transaction, it just reads the current value--- of the TVar.-readTVarIO :: TVar a -> IO a-readTVarIO = atomically . readTVar-{-# INLINE readTVarIO #-}-#endif---#if ! (MIN_VERSION_stm(2,3,0))---- Like 'modifyIORef' but for @TVar@.--- | Mutate the contents of a @TVar@. /N.B./, this version is--- non-strict.-modifyTVar :: TVar a -> (a -> a) -> STM ()-modifyTVar var f = do-    x <- readTVar var-    writeTVar var (f x)-{-# INLINE modifyTVar #-}----- | Strict version of 'modifyTVar'.-modifyTVar' :: TVar a -> (a -> a) -> STM ()-modifyTVar' var f = do-    x <- readTVar var-    writeTVar var $! f x-{-# INLINE modifyTVar' #-}----- Like 'swapTMVar' but for @TVar@.--- | Swap the contents of a @TVar@ for a new value.-swapTVar :: TVar a -> a -> STM a-swapTVar var new = do-    old <- readTVar var-    writeTVar var new-    return old-{-# INLINE swapTVar #-}--#endif------------------------------------------------------------------------------------------------------------------------------ fin.
stm-chans.cabal view
@@ -1,52 +1,76 @@+Cabal-Version:  2.2+-- Cabal >=2.2 is required for:+--    <https://cabal.readthedocs.io/en/latest/cabal-package.html#common-stanzas>+-- Since 2.1, the Cabal-Version must be the absolutely first thing+-- in the file, even before comments.  Also, no longer uses ">=".+--    <https://github.com/haskell/cabal/issues/4899>+ ------------------------------------------------------------------- wren ng thornton <wren@community.haskell.org>    ~ 2012.02.25+-- wren gayle romano <wren@cpan.org>                ~ 2026-02-26 ---------------------------------------------------------------- --- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with:--- and source-repository:.-Cabal-Version:  >= 1.6--- We need a custom build in order to define __HADDOCK__-Build-Type:     Custom- Name:           stm-chans-Version:        1.3.1+Version:        3.0.0.11+Build-Type:     Simple Stability:      provisional-Homepage:       http://code.haskell.org/~wren/-Author:         wren ng thornton, Thomas DuBuisson-Maintainer:     wren@community.haskell.org-Copyright:      Copyright (c) 2011--2012 wren ng thornton-License:        BSD3+Homepage:       https://wrengr.org/software/hackage.html+Bug-Reports:    https://github.com/wrengr/stm-chans/issues+Author:         wren gayle romano, Thomas DuBuisson+Maintainer:     wren@cpan.org+Copyright:      2011–2025 wren romano+-- Cabal-2.2 requires us to say "BSD-3-Clause" not "BSD3"+License:        BSD-3-Clause License-File:   LICENSE  Category:       Concurrency Synopsis:       Additional types of channels for STM. Description:    Additional types of channels for STM. -Tested-With:-    GHC == 6.12.1, GHC == 6.12.3 Extra-source-files:-    AUTHORS, README, VERSION+    AUTHORS, README.md, CHANGELOG++-- This used to be tested on 7.8.3 and 7.10.1, but we don't verify that by CI.+-- <https://github.com/wrengr/stm-chans/actions?query=workflow%3Aci>+Tested-With:+    GHC ==8.0.2,+    GHC ==8.2.2,+    GHC ==8.4.4,+    GHC ==8.6.5,+    GHC ==8.8.4,+    GHC ==8.10.3,+    GHC ==9.0.1,+    GHC ==9.2.4,+    GHC ==9.4.8,+    GHC ==9.6.5,+    GHC ==9.8.2,+    GHC ==9.10.1,+    GHC ==9.12.1,+    GHC ==9.14.1++---------------------------------------------------------------- Source-Repository head-    Type:     darcs-    Location: http://community.haskell.org/~wren/stm-chans+    Type:     git+    Location: https://github.com/wrengr/stm-chans.git  ---------------------------------------------------------------- Library-    -- Not sure what the real minbounds are for base and stm...+    Default-Language: Haskell2010+    -- N.B., the following versions are required for:+    -- * stm >= 2.4:   T{,B}Queue and newBroadcastTChan{,IO}+    -- * stm >= 2.3.0: fast tryReadTChan, peekTChan, tryPeekTChan,+    --         tryReadTMVar, modifyTVar, modifyTVar', swapTVar.+    -- * stm >= 2.1.2: fast readTVarIO.     ---    -- N.B., stm >= 2.1.2 is required for fast readTVarIO. And-    -- stm >= 2.3.0 is required for fast tryReadTChan, peekTChan,-    -- tryPeekTChan, tryReadTMVar, modifyTVar, modifyTVar', swapTVar.+    -- Not sure what the real minbound is for base...     Build-Depends: base >= 4.1 && < 5-                 , stm  >= 2.1.1-    +                 , stm  >= 2.4+     Hs-Source-Dirs:  src     Exposed-Modules: Control.Concurrent.STM.TBChan                    , Control.Concurrent.STM.TBMChan                    , Control.Concurrent.STM.TMChan-                   , Control.Concurrent.STM.TChan.Compat-                   , Control.Concurrent.STM.TMVar.Compat-                   , Control.Concurrent.STM.TVar.Compat+                   , Control.Concurrent.STM.TBMQueue+                   , Control.Concurrent.STM.TMQueue  ---------------------------------------------------------------- ----------------------------------------------------------- fin.