-----------------------------------------------------------------------------
-- |
-- 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.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
readListPrec :: ReadPrec [BufferedPipeReader]
$creadListPrec :: ReadPrec [BufferedPipeReader]
readPrec :: ReadPrec BufferedPipeReader
$creadPrec :: ReadPrec BufferedPipeReader
readList :: ReadS [BufferedPipeReader]
$creadList :: ReadS [BufferedPipeReader]
readsPrec :: Int -> ReadS BufferedPipeReader
$creadsPrec :: Int -> ReadS 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
showList :: [BufferedPipeReader] -> ShowS
$cshowList :: [BufferedPipeReader] -> ShowS
show :: BufferedPipeReader -> String
$cshow :: BufferedPipeReader -> String
showsPrec :: Int -> BufferedPipeReader -> ShowS
$cshowsPrec :: Int -> 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 (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 (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

        (TChan (Int, Bool, String)
chan, TVar (Maybe String)
str, TVar Bool
rst) <- IO (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
initV
        [(Int, Bool, String)]
-> ((Int, Bool, String) -> IO ThreadId) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, Bool, String)]
ps (((Int, Bool, String) -> IO ThreadId) -> IO ())
-> ((Int, Bool, String) -> IO ThreadId) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(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
        TChan (Int, Bool, String)
-> TVar (Maybe String) -> TVar Bool -> IO ()
writer TChan (Int, Bool, String)
chan TVar (Maybe String)
str TVar Bool
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
            TChan (Int, Bool, String)
tc <- STM (TChan (Int, Bool, String))
forall a. STM (TChan a)
newTChan
            TVar (Maybe String)
ts <- Maybe String -> STM (TVar (Maybe String))
forall a. a -> STM (TVar a)
newTVar Maybe String
forall a. Maybe a
Nothing
            TVar Bool
tb <- Bool -> STM (TVar Bool)
forall a. a -> STM (TVar a)
newTVar Bool
False
            (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
-> STM (TChan (Int, Bool, String), TVar (Maybe String), TVar Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (TChan (Int, Bool, String)
tc, TVar (Maybe String)
ts, TVar Bool
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
            String
fp' <- String -> IO String
expandEnv String
fp
            String -> IOMode -> IO Handle
openFile String
fp' IOMode
ReadWriteMode IO Handle -> (Handle -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO String
hGetLine IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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)
            (Int, Bool, String) -> TChan (Int, Bool, String) -> IO ()
reader (Int, Bool, String)
p TChan (Int, Bool, String)
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
            (Int
to, Bool
tg, String
dt, TVar Bool
ntb) <- IO (Int, Bool, String, TVar Bool)
update
            String -> IO ()
cb String
dt
            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
Reveal Int
0
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
sfork (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> TVar (Maybe String) -> TVar Bool -> IO ()
reset Int
to Bool
tg TVar (Maybe String)
ts TVar Bool
ntb
            TChan (Int, Bool, String)
-> TVar (Maybe String) -> TVar Bool -> IO ()
writer TChan (Int, Bool, String)
tc TVar (Maybe String)
ts TVar Bool
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
                (Int
to, Bool
tg, String
dt) <- TChan (Int, Bool, String) -> STM (Int, Bool, String)
forall a. TChan a -> STM a
readTChan TChan (Int, Bool, String)
tc
                Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
to Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe String) -> Maybe String -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe String)
ts (Maybe String -> STM ()) -> Maybe String -> STM ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
dt
                TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
otb Bool
False
                TVar Bool
tb <- Bool -> STM (TVar Bool)
forall a. a -> STM (TVar a)
newTVar Bool
True
                (Int, Bool, String, TVar Bool)
-> STM (Int, Bool, String, TVar Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
to, Bool
tg, String
dt, TVar Bool
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
cb