From aa507d0bda3919e1885edb327b855908f2aafcb8 Mon Sep 17 00:00:00 2001
From: Jochen Keil <jochen.keil@gmail.com>
Date: Wed, 8 Aug 2012 12:12:17 +0200
Subject: BufferedPipeReader: A plugin for temporary data display

This plugin allows to display data from multiple pipes.
New data will always overwrite the currently displayed data.
However, if a timeout is specified, the previous content is restored.

Configuration works like this:
BufferedPipeReader <Alias> [ ( Timeout, "/path/to/fifo/pipe" ), (..), .. ]

If Timeout is set to 0 then the content is persistent, i.e. it will be
reset to any previous value, it will itself become the previous value.

If Timeout is set to a negative value the earth will stop spinning, so
don't do it.
---
 src/Config.hs                     |  3 +-
 src/Plugins/BufferedPipeReader.hs | 78 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 80 insertions(+), 1 deletion(-)
 create mode 100644 src/Plugins/BufferedPipeReader.hs

(limited to 'src')

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 )
-- 
cgit v1.2.3