-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.PipeReader
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A plugin for reading from named pipes
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.PipeReader(PipeReader(..)) where

import System.IO
import Xmobar.Run.Exec(Exec(..))
import Xmobar.System.Environment(expandEnv)
import System.Posix.Files
import Control.Concurrent(threadDelay)
import Control.Exception
import Control.Monad(forever, unless)

data PipeReader = PipeReader String String
    deriving (ReadPrec [PipeReader]
ReadPrec PipeReader
Int -> ReadS PipeReader
ReadS [PipeReader]
(Int -> ReadS PipeReader)
-> ReadS [PipeReader]
-> ReadPrec PipeReader
-> ReadPrec [PipeReader]
-> Read PipeReader
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PipeReader
readsPrec :: Int -> ReadS PipeReader
$creadList :: ReadS [PipeReader]
readList :: ReadS [PipeReader]
$creadPrec :: ReadPrec PipeReader
readPrec :: ReadPrec PipeReader
$creadListPrec :: ReadPrec [PipeReader]
readListPrec :: ReadPrec [PipeReader]
Read, Int -> PipeReader -> ShowS
[PipeReader] -> ShowS
PipeReader -> String
(Int -> PipeReader -> ShowS)
-> (PipeReader -> String)
-> ([PipeReader] -> ShowS)
-> Show PipeReader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PipeReader -> ShowS
showsPrec :: Int -> PipeReader -> ShowS
$cshow :: PipeReader -> String
show :: PipeReader -> String
$cshowList :: [PipeReader] -> ShowS
showList :: [PipeReader] -> ShowS
Show)

instance Exec PipeReader where
    alias :: PipeReader -> String
alias (PipeReader String
_ String
a)    = String
a
    start :: PipeReader -> (String -> IO ()) -> IO ()
start (PipeReader String
p String
_) String -> IO ()
cb = do
        (def, pipe) <- Char -> String -> (String, String)
forall {a}. Eq a => a -> [a] -> ([a], [a])
split Char
':' (String -> (String, String)) -> IO String -> IO (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
expandEnv String
p
        unless (null def) (cb def)
        checkPipe pipe
        h <- openFile pipe ReadWriteMode
        forever (hGetLine h >>= cb)
      where
        split :: a -> [a] -> ([a], [a])
split a
c [a]
xs | a
c a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs = let ([a]
pre, [a]
post) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=) [a]
xs
                                   in ([a]
pre, (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
post)
                   | Bool
otherwise   = ([], [a]
xs)

checkPipe :: FilePath -> IO ()
checkPipe :: String -> IO ()
checkPipe String
file =
    (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
_) -> IO ()
waitForPipe) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        status <- String -> IO FileStatus
getFileStatus String
file
        unless (isNamedPipe status) waitForPipe
    where waitForPipe :: IO ()
waitForPipe = Int -> IO ()
threadDelay Int
1000000 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
checkPipe String
file