Back to app/src, since it seems they're the default convention for stack

1 files changed, 88 insertions, 0 deletions

diff --git a/src/Xmobar/Plugins/BufferedPipeReader.hs b/src/Xmobar/Plugins/BufferedPipeReader.hs
new file mode 100644
index 0000000..65ecea2
--- /dev/null
+++ b/src/Xmobar/Plugins/BufferedPipeReader.hs
@@ -0,0 +1,88 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 Xmobar.Plugins.BufferedPipeReader(BufferedPipeReader(..)) where
+
+import Control.Monad(forM_, when, void)
+import Control.Concurrent
+import Control.Concurrent.STM
+import System.IO
+import System.IO.Unsafe(unsafePerformIO)
+
+import Xmobar.Utils(hGetLineSafe)
+import Xmobar.Run.Commands
+import Xmobar.System.Signal
+import Xmobar.System.Environment
+
+data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)]
+    deriving (Read, Show)
+
+{-# NOINLINE signal #-}
+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), TVar (Maybe String), TVar Bool)
+        initV = atomically $ do
+            tc <- newTChan
+            ts <- newTVar Nothing
+            tb <- newTVar False
+            return (tc, ts, tb)
+
+        reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO ()
+        reader p@(to, tg, fp) tc = do
+            fp' <- expandEnv fp
+            openFile fp' ReadWriteMode >>= hGetLineSafe >>= \dt ->
+                atomically $ writeTChan tc (to, tg, dt)
+            reader p tc
+
+        writer :: TChan (Int, Bool, String)
+               -> TVar (Maybe String) -> TVar Bool -> IO ()
+        writer tc ts otb = do
+            (to, tg, dt, ntb) <- update
+            cb dt
+            when tg $ putMVar signal $ Reveal 0
+            when (to /= 0) $ sfork $ reset to tg ts ntb
+            writer tc ts ntb
+
+            where
+            sfork :: IO () -> IO ()
+            sfork f = void (forkIO f)
+
+            update :: IO (Int, Bool, String, TVar Bool)
+            update = atomically $ do
+                (to, tg, dt) <- readTChan tc
+                when (to == 0) $ writeTVar ts $ Just dt
+                writeTVar otb False
+                tb <- newTVar True
+                return (to, tg, dt, tb)
+
+        reset :: Int -> Bool -> TVar (Maybe 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 0
+                readTVarIO ts >>= maybe (return ()) cb