diff options
author | Jochen Keil <jochen.keil@gmail.com> | 2012-08-09 11:44:39 +0200 |
---|---|---|
committer | Jochen Keil <jochen.keil@gmail.com> | 2012-08-09 12:07:17 +0200 |
commit | fc474471e12afd5ec958082a7246f2ee22fcc2cf (patch) | |
tree | 4d18fc0f2fd48c804a7d59af7d780d113ce41b1e /src | |
parent | dd78c8bfa52ba0b10e6acf8bde8d467fb02a8d4e (diff) | |
download | xmobar-fc474471e12afd5ec958082a7246f2ee22fcc2cf.tar.gz xmobar-fc474471e12afd5ec958082a7246f2ee22fcc2cf.tar.bz2 |
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.
Diffstat (limited to 'src')
-rw-r--r-- | src/Plugins/BufferedPipeReader.hs | 15 |
1 files changed, 8 insertions, 7 deletions
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 |