diff options
author | Pavan Rikhi <pavan.rikhi@gmail.com> | 2018-03-17 22:48:24 -0400 |
---|---|---|
committer | jao <jao@gnu.org> | 2018-11-21 21:41:35 +0000 |
commit | 4d1402a1a7d87767267d48a77998e4fb13395b31 (patch) | |
tree | 17fd6160dc1fa9c8a0676a94bcf8d19b551c655c /src/Xmobar/Plugins/BufferedPipeReader.hs | |
parent | 9e2a5c7daddf683d4be7c318aefed3da3ea7a89a (diff) | |
download | xmobar-4d1402a1a7d87767267d48a77998e4fb13395b31.tar.gz xmobar-4d1402a1a7d87767267d48a77998e4fb13395b31.tar.bz2 |
Split Modules into Library & Executable Structure
Move the Main module to a new `app` directory. All other modules have
been nested under the `Xmobar` name. Lots of module headers & imports
were updated.
Diffstat (limited to 'src/Xmobar/Plugins/BufferedPipeReader.hs')
-rw-r--r-- | src/Xmobar/Plugins/BufferedPipeReader.hs | 87 |
1 files changed, 87 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/BufferedPipeReader.hs b/src/Xmobar/Plugins/BufferedPipeReader.hs new file mode 100644 index 0000000..d4d30a1 --- /dev/null +++ b/src/Xmobar/Plugins/BufferedPipeReader.hs @@ -0,0 +1,87 @@ +----------------------------------------------------------------------------- +-- | +-- 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 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 |