summaryrefslogtreecommitdiffhomepage
path: root/src/Plugins/BufferedPipeReader.hs
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2012-08-13 15:11:55 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2012-08-13 15:12:11 +0200
commit359769944a8cb0ac80537458af0e49cc8f68d01b (patch)
tree484068988be1571b25ff0a81c7e74cb9cd579325 /src/Plugins/BufferedPipeReader.hs
parent73837127825529d44e2e0d4ed440da0d7b180020 (diff)
parent05f268c3a831325f65a662c6ccdff75a1c441d83 (diff)
downloadxmobar-359769944a8cb0ac80537458af0e49cc8f68d01b.tar.gz
xmobar-359769944a8cb0ac80537458af0e49cc8f68d01b.tar.bz2
Merge for pull request #53
Diffstat (limited to 'src/Plugins/BufferedPipeReader.hs')
-rw-r--r--src/Plugins/BufferedPipeReader.hs83
1 files changed, 83 insertions, 0 deletions
diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs
new file mode 100644
index 0000000..be6a652
--- /dev/null
+++ b/src/Plugins/BufferedPipeReader.hs
@@ -0,0 +1,83 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Plugins.BufferedPipeReader
+-- Copyright : (c) Jochen Keil
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : Jochen Keil <jochen dot keil at gmail dot com>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- A plugin for reading (temporarily) from named pipes with reset
+--
+-----------------------------------------------------------------------------
+
+module Plugins.BufferedPipeReader where
+
+import Control.Monad(forM_, when)
+import Control.Concurrent
+import Control.Concurrent.STM
+import System.IO
+import System.IO.Unsafe(unsafePerformIO)
+
+import Plugins
+import Signal
+
+data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)]
+ deriving (Read, Show)
+
+signal :: MVar SignalType
+signal = unsafePerformIO newEmptyMVar
+
+instance Exec BufferedPipeReader where
+ alias ( BufferedPipeReader a _ ) = a
+
+ trigger br@( BufferedPipeReader _ _ ) sh =
+ takeMVar signal >>= sh . Just >> trigger br sh
+
+ start ( BufferedPipeReader _ ps ) cb = do
+
+ (chan, str, rst) <- initV
+ forM_ ps $ \p -> forkIO $ reader p chan
+ writer chan str rst
+
+ where
+ initV :: IO ( TChan (Int, Bool, String), TMVar String, TVar Bool )
+ initV = atomically $ do
+ tc <- newTChan
+ ts <- newEmptyTMVar
+ tb <- newTVar False
+ return (tc, ts, tb)
+
+ reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO ()
+ reader p@(to, tg, fp) tc = do
+ openFile fp ReadWriteMode >>= hGetLineSafe >>= \dt ->
+ atomically $ writeTChan tc (to, tg, dt)
+ reader p tc
+
+ writer :: TChan (Int, Bool, String) -> TMVar String -> TVar Bool -> IO ()
+ writer tc ts otb = do
+ (to, tg, dt, ntb) <- update
+ cb dt
+ when tg $ putMVar signal Reveal
+ when (to /= 0) $ sfork $ reset to tg ts ntb
+ writer tc ts ntb
+
+ where
+ sfork :: IO () -> IO ()
+ sfork f = forkIO f >> return ()
+
+ update :: IO (Int, Bool, String, TVar Bool)
+ update = atomically $ do
+ (to, tg, dt) <- readTChan tc
+ when (to == 0) $ tryPutTMVar ts dt >> return ()
+ writeTVar otb False
+ tb <- newTVar True
+ return (to, tg, dt, tb)
+
+ reset :: Int -> Bool -> TMVar String -> TVar Bool -> IO ()
+ reset to tg ts tb = do
+ threadDelay ( to * 100 * 1000 )
+ readTVarIO tb >>= \b -> when b $ do
+ when tg $ putMVar signal Hide
+ atomically (tryTakeTMVar ts) >>= maybe (return ()) cb