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.Run.Exec
import Xmobar.System.Signal
import Xmobar.System.Environment
data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)]
deriving (ReadPrec [BufferedPipeReader]
ReadPrec BufferedPipeReader
Int -> ReadS BufferedPipeReader
ReadS [BufferedPipeReader]
(Int -> ReadS BufferedPipeReader)
-> ReadS [BufferedPipeReader]
-> ReadPrec BufferedPipeReader
-> ReadPrec [BufferedPipeReader]
-> Read BufferedPipeReader
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BufferedPipeReader
readsPrec :: Int -> ReadS BufferedPipeReader
$creadList :: ReadS [BufferedPipeReader]
readList :: ReadS [BufferedPipeReader]
$creadPrec :: ReadPrec BufferedPipeReader
readPrec :: ReadPrec BufferedPipeReader
$creadListPrec :: ReadPrec [BufferedPipeReader]
readListPrec :: ReadPrec [BufferedPipeReader]
Read, Int -> BufferedPipeReader -> ShowS
[BufferedPipeReader] -> ShowS
BufferedPipeReader -> String
(Int -> BufferedPipeReader -> ShowS)
-> (BufferedPipeReader -> String)
-> ([BufferedPipeReader] -> ShowS)
-> Show BufferedPipeReader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BufferedPipeReader -> ShowS
showsPrec :: Int -> BufferedPipeReader -> ShowS
$cshow :: BufferedPipeReader -> String
show :: BufferedPipeReader -> String
$cshowList :: [BufferedPipeReader] -> ShowS
showList :: [BufferedPipeReader] -> ShowS
Show)
{-# NOINLINE signal #-}
signal :: MVar SignalType
signal :: MVar SignalType
signal = IO (MVar SignalType) -> MVar SignalType
forall a. IO a -> a
unsafePerformIO IO (MVar SignalType)
forall a. IO (MVar a)
newEmptyMVar
instance Exec BufferedPipeReader where
alias :: BufferedPipeReader -> String
alias ( BufferedPipeReader String
a [(Int, Bool, String)]
_ ) = String
a
trigger :: BufferedPipeReader -> (Maybe SignalType -> IO ()) -> IO ()
trigger br :: BufferedPipeReader
br@( BufferedPipeReader String
_ [(Int, Bool, String)]
_ ) Maybe SignalType -> IO ()
sh =
MVar SignalType -> IO SignalType
forall a. MVar a -> IO a
takeMVar MVar SignalType
signal IO SignalType -> (SignalType -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe SignalType -> IO ()
sh (Maybe SignalType -> IO ())
-> (SignalType -> Maybe SignalType) -> SignalType -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignalType -> Maybe SignalType
forall a. a -> Maybe a
Just IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferedPipeReader -> (Maybe SignalType -> IO ()) -> IO ()
forall e. Exec e => e -> (Maybe SignalType -> IO ()) -> IO ()
trigger BufferedPipeReader
br Maybe SignalType -> IO ()
sh
start :: BufferedPipeReader -> (String -> IO ()) -> IO ()
start ( BufferedPipeReader String
_ [(Int, Bool, String)]
ps ) String -> IO ()
cb = do
(chan, str, rst) <- IO (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
initV
forM_ ps $ \(Int, Bool, String)
p -> IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (Int, Bool, String) -> TChan (Int, Bool, String) -> IO ()
reader (Int, Bool, String)
p TChan (Int, Bool, String)
chan
writer chan str rst
where
initV :: IO (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
initV :: IO (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
initV = STM (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
-> IO (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
forall a. STM a -> IO a
atomically (STM (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
-> IO (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool))
-> STM (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
-> IO (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
forall a b. (a -> b) -> a -> b
$ do
tc <- STM (TChan (Int, Bool, String))
forall a. STM (TChan a)
newTChan
ts <- newTVar Nothing
tb <- newTVar False
return (tc, ts, tb)
reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO ()
reader :: (Int, Bool, String) -> TChan (Int, Bool, String) -> IO ()
reader p :: (Int, Bool, String)
p@(Int
to, Bool
tg, String
fp) TChan (Int, Bool, String)
tc = do
fp' <- String -> IO String
expandEnv String
fp
openFile fp' ReadWriteMode >>= hGetLine >>= \String
dt ->
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan (Int, Bool, String) -> (Int, Bool, String) -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan (Int, Bool, String)
tc (Int
to, Bool
tg, String
dt)
reader p tc
writer :: TChan (Int, Bool, String)
-> TVar (Maybe String) -> TVar Bool -> IO ()
writer :: TChan (Int, Bool, String)
-> TVar (Maybe String) -> TVar Bool -> IO ()
writer TChan (Int, Bool, String)
tc TVar (Maybe String)
ts TVar Bool
otb = do
(to, tg, dt, ntb) <- IO (Int, Bool, String, TVar Bool)
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 :: IO () -> IO ()
sfork IO ()
f = IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ThreadId
forkIO IO ()
f)
update :: IO (Int, Bool, String, TVar Bool)
update :: IO (Int, Bool, String, TVar Bool)
update = STM (Int, Bool, String, TVar Bool)
-> IO (Int, Bool, String, TVar Bool)
forall a. STM a -> IO a
atomically (STM (Int, Bool, String, TVar Bool)
-> IO (Int, Bool, String, TVar Bool))
-> STM (Int, Bool, String, TVar Bool)
-> IO (Int, Bool, String, TVar Bool)
forall a b. (a -> b) -> a -> b
$ do
(to, tg, dt) <- TChan (Int, Bool, String) -> STM (Int, Bool, String)
forall a. TChan a -> STM a
readTChan TChan (Int, Bool, String)
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 :: Int -> Bool -> TVar (Maybe String) -> TVar Bool -> IO ()
reset Int
to Bool
tg TVar (Maybe String)
ts TVar Bool
tb = do
Int -> IO ()
threadDelay ( Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 )
TVar Bool -> IO Bool
forall a. TVar a -> IO a
readTVarIO TVar Bool
tb IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tg (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar SignalType -> SignalType -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar SignalType
signal (SignalType -> IO ()) -> SignalType -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> SignalType
Hide Int
0
TVar (Maybe String) -> IO (Maybe String)
forall a. TVar a -> IO a
readTVarIO TVar (Maybe String)
ts IO (Maybe String) -> (Maybe String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
cb