From 3a2775bc5bd132109c8cfbd84b11a1e7cf633311 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Sat, 17 Oct 2015 19:21:45 +0200
Subject: MSampleVarX: take with takeSV and read with readSV

---
 Control/Concurrent/MSampleVarX.hs | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/Control/Concurrent/MSampleVarX.hs b/Control/Concurrent/MSampleVarX.hs
index 578d391..88256f5 100644
--- a/Control/Concurrent/MSampleVarX.hs
+++ b/Control/Concurrent/MSampleVarX.hs
@@ -16,19 +16,20 @@
 -- cause 'writeSampleVar' to hang.  The 'MSampleVar' in this module is immune
 -- to this error, and has a simpler implementation.
 --
-module Control.Concurrent.MSampleVar
+module Control.Concurrent.MSampleVarX
        ( -- * Sample Variables
          MSampleVar,
          newEmptySV, -- :: IO (MSampleVar a)
          newSV,      -- :: a -> IO (MSampleVar a)
          emptySV,    -- :: MSampleVar a -> IO ()
          readSV,     -- :: MSampleVar a -> IO a
+         takeSV,     -- :: MSampleVar a -> IO a
          writeSV,    -- :: MSampleVar a -> a -> IO ()
          isEmptySV,  -- :: MSampleVar a -> IO Bool
        ) where
 
 import Control.Monad(void,join)
-import Control.Concurrent.MVar(MVar,newMVar,newEmptyMVar,tryTakeMVar,takeMVar,putMVar,withMVar,isEmptyMVar)
+import Control.Concurrent.MVar(MVar,newMVar,newEmptyMVar,readMVar,tryTakeMVar,takeMVar,putMVar,withMVar,isEmptyMVar)
 import Control.Exception(mask_)
 import Data.Typeable
 
@@ -101,7 +102,7 @@ isEmptySV (MSampleVar _ ls) = withMVar ls isEmptyMVar
   -- (withMVar ls) might block, interrupting is okay
 
 -- | If the 'MSampleVar' is full, forget the value and leave it empty.
--- Otherwise, do nothing.  This avoids any the FIFO queue of blocked 'readSV'
+-- Otherwise, do nothing.  This avoids any the FIFO queue of blocked 'takeSV'
 -- threads.
 --
 -- 'emptySV' can block and be interrupted, in which case it does nothing.  If
@@ -110,18 +111,23 @@ emptySV :: MSampleVar a -> IO ()
 emptySV (MSampleVar _ ls) = withMVar ls (void . tryTakeMVar)
   -- (withMVar ls) might block, interrupting is okay
 
--- | Wait for a value to become available, then take it and return.  The queue
+-- | Wait for a value to become available, then read it and return.  The queue
 -- of blocked 'readSV' threads is a fair FIFO queue.
 --
 -- 'readSV' can block and be interrupted, in which case it takes nothing.  If
--- 'readSV returns normally then it has taken a value.
+-- 'readSV' returns normally then it has taken a value.
 readSV :: MSampleVar a -> IO a
 readSV (MSampleVar rq ls) =  mask_ $ withMVar rq $ \ () ->
-  join $ withMVar ls (return . takeMVar)
+  join $ withMVar ls (return . readMVar)
   -- (withMVar rq) might block, interrupting is okay
   -- (withMVar ls) might block, interrupting is okay
   -- join (takeMVar _) will block if empty, interrupting is okay
 
+-- | Similar to 'readSV' but empty the variable after reading it.
+takeSV :: MSampleVar a -> IO a
+takeSV (MSampleVar rq ls) =  mask_ $ withMVar rq $ \ () ->
+  join $ withMVar ls (return . takeMVar)
+
 -- | Write a value into the 'MSampleVar', overwriting any previous value that
 -- was there.
 --
-- 
cgit v1.2.3