From fc474471e12afd5ec958082a7246f2ee22fcc2cf Mon Sep 17 00:00:00 2001
From: Jochen Keil <jochen.keil@gmail.com>
Date: Thu, 9 Aug 2012 11:44:39 +0200
Subject: Bugfix: Replace TVar with TMVar for the old value

This solves a problem when there is only one pipe in place. With a
default value of "" and only one pipe with a timeout the value is
overwritten with "" after the timeout. To prevent this from happening a
TMVar is used which will never be filled if there is only one pipe.
---
 src/Plugins/BufferedPipeReader.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs
index 602862e..8a91967 100644
--- a/src/Plugins/BufferedPipeReader.hs
+++ b/src/Plugins/BufferedPipeReader.hs
@@ -42,10 +42,10 @@ instance Exec BufferedPipeReader where
         writer chan str rst
 
         where
-        initV :: IO ( TChan (Int, Bool, String), TVar String, TVar Bool )
+        initV :: IO ( TChan (Int, Bool, String), TMVar String, TVar Bool )
         initV = atomically $ do
             tc <- newTChan
-            ts <- newTVar ""
+            ts <- newEmptyTMVar
             tb <- newTVar False
             return (tc, ts, tb)
 
@@ -55,7 +55,7 @@ instance Exec BufferedPipeReader where
                 atomically $ writeTChan tc (to, tg, dt)
             reader p tc
 
-        writer :: TChan (Int, Bool, String) -> TVar String -> TVar Bool -> IO ()
+        writer :: TChan (Int, Bool, String) -> TMVar String -> TVar Bool -> IO ()
         writer tc ts otb = do
             (to, tg, dt, ntb) <- update
             cb dt
@@ -70,13 +70,14 @@ instance Exec BufferedPipeReader where
             update :: IO (Int, Bool, String, TVar Bool)
             update = atomically $ do
                 (to, tg, dt) <- readTChan tc
-                when (to == 0) $ writeTVar ts dt
+                when (to == 0) $ tryPutTMVar ts dt >> return ()
                 writeTVar otb False
                 tb <- newTVar True
                 return (to, tg, dt, tb)
 
-        reset :: Int -> TVar String -> TVar Bool -> IO ()
+        reset :: Int -> TMVar String -> TVar Bool -> IO ()
         reset to ts tb = do
             threadDelay ( to * 100 * 1000 )
-            readTVarIO tb >>=
-                flip when ( putMVar signal Hide >> readTVarIO ts >>= cb )
+            readTVarIO tb >>= \b -> when b $ do
+                putMVar signal Hide
+                atomically (tryTakeTMVar ts) >>= maybe (return ()) cb
-- 
cgit v1.2.3