From 50134d5b5c4baabdfb35c0aeb8bf53d29f009c4d Mon Sep 17 00:00:00 2001 From: jao Date: Wed, 21 Nov 2018 23:51:41 +0000 Subject: All sources moved inside src --- src/lib/Xmobar/Plugins/BufferedPipeReader.hs | 87 ++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 src/lib/Xmobar/Plugins/BufferedPipeReader.hs (limited to 'src/lib/Xmobar/Plugins/BufferedPipeReader.hs') diff --git a/src/lib/Xmobar/Plugins/BufferedPipeReader.hs b/src/lib/Xmobar/Plugins/BufferedPipeReader.hs new file mode 100644 index 0000000..d4d30a1 --- /dev/null +++ b/src/lib/Xmobar/Plugins/BufferedPipeReader.hs @@ -0,0 +1,87 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.BufferedPipeReader +-- Copyright : (c) Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jochen Keil +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin for reading (temporarily) from named pipes with reset +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.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.Environment +import Xmobar.Plugins +import Xmobar.Signal + +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 -- cgit v1.2.3