-----------------------------------------------------------------------------
-- |
-- 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]
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
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 = forall a. IO a -> a
unsafePerformIO 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 =
        forall a. MVar a -> IO a
takeMVar MVar SignalType
signal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe SignalType -> IO ()
sh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, Bool, String)]
ps forall a b. (a -> b) -> a -> b
$ \(Int, Bool, String)
p -> IO () -> IO ThreadId
forkIO 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 = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
            TChan (Int, Bool, String)
tc <- forall a. STM (TChan a)
newTChan
            TVar (Maybe String)
ts <- forall a. a -> STM (TVar a)
newTVar forall a. Maybe a
Nothing
            TVar Bool
tb <- forall a. a -> STM (TVar a)
newTVar Bool
False
            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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO String
hGetLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
dt ->
                forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ 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
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tg forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar SignalType
signal forall a b. (a -> b) -> a -> b
$ Int -> SignalType
Reveal Int
0
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
to forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
sfork 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 = 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 = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
                (Int
to, Bool
tg, String
dt) <- forall a. TChan a -> STM a
readTChan TChan (Int, Bool, String)
tc
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
to forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe String)
ts forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
dt
                forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
otb Bool
False
                TVar Bool
tb <- forall a. a -> STM (TVar a)
newTVar Bool
True
                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 forall a. Num a => a -> a -> a
* Int
100 forall a. Num a => a -> a -> a
* Int
1000 )
            forall a. TVar a -> IO a
readTVarIO TVar Bool
tb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b forall a b. (a -> b) -> a -> b
$ do
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tg forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar SignalType
signal forall a b. (a -> b) -> a -> b
$ Int -> SignalType
Hide Int
0
                forall a. TVar a -> IO a
readTVarIO TVar (Maybe String)
ts forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
cb