summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--src/Config.hs3
-rw-r--r--src/Plugins/BufferedPipeReader.hs78
2 files changed, 80 insertions, 1 deletions
diff --git a/src/Config.hs b/src/Config.hs
index 4405314..712687d 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -28,6 +28,7 @@ import {-# SOURCE #-} Runnable
import Plugins.Monitors
import Plugins.Date
import Plugins.PipeReader
+import Plugins.BufferedPipeReader
import Plugins.CommandReader
import Plugins.StdinReader
import Plugins.XMonadLog
@@ -113,7 +114,7 @@ infixr :*:
-- the 'Runnable.Runnable' Read instance. To install a plugin just add
-- the plugin's type to the list of types (separated by ':*:') appearing in
-- this function's type signature.
-runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*:
+runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*:
#ifdef INOTIFY
Mail :*: MBox :*:
#endif
diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs
new file mode 100644
index 0000000..1fb9dcb
--- /dev/null
+++ b/src/Plugins/BufferedPipeReader.hs
@@ -0,0 +1,78 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+
+data BufferedPipeReader = BufferedPipeReader String [(Int, String)]
+ deriving (Read, Show)
+
+-- pipeState :: MVar String
+-- pipeState = unsafePerformIO $ newMVar ""
+
+-- pipe :: (String -> IO ()) -> Handle -> IO ()
+-- pipe cb h = hGetLineSafe h >>= cb
+
+instance Exec BufferedPipeReader where
+ alias ( BufferedPipeReader a _ ) = a
+ 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, String), TVar String, TVar Bool )
+ initV = atomically $ do
+ tc <- newTChan
+ ts <- newTVar ""
+ tb <- newTVar False
+ return (tc, ts, tb)
+
+ reader :: (Int, FilePath) -> TChan (Int, String) -> IO ()
+ reader p@(to, fp) tc = do
+ openFile fp ReadWriteMode >>= hGetLineSafe >>= \dt ->
+ atomically $ writeTChan tc (to, dt)
+ reader p tc
+
+ writer :: TChan (Int, String) -> TVar String -> TVar Bool -> IO ()
+ writer tc ts otb = do
+ (to, dt, ntb) <- update
+ cb dt
+ when (to /= 0) $ sfork $ reset to ts ntb
+ writer tc ts ntb
+
+ where
+ sfork :: IO () -> IO ()
+ sfork f = forkIO f >> return ()
+
+ update :: IO (Int, String, TVar Bool)
+ update = atomically $ do
+ (to, dt) <- readTChan tc
+ when (to == 0) $ writeTVar ts dt
+ writeTVar otb False
+ tb <- newTVar True
+ return (to, dt, tb)
+
+ reset :: Int -> TVar String -> TVar Bool -> IO ()
+ reset to ts tb = do
+ threadDelay ( to * 100 * 1000 )
+ readTVarIO tb >>= flip when ( readTVarIO ts >>= cb )