-----------------------------------------------------------------------------
-- |
-- 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
$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