-----------------------------------------------------------------------------
-- |
-- 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
readListPrec :: ReadPrec [PipeReader]
$creadListPrec :: ReadPrec [PipeReader]
readPrec :: ReadPrec PipeReader
$creadPrec :: ReadPrec PipeReader
readList :: ReadS [PipeReader]
$creadList :: ReadS [PipeReader]
readsPrec :: Int -> ReadS PipeReader
$creadsPrec :: Int -> ReadS 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
showList :: [PipeReader] -> ShowS
$cshowList :: [PipeReader] -> ShowS
show :: PipeReader -> String
$cshow :: PipeReader -> String
showsPrec :: Int -> PipeReader -> ShowS
$cshowsPrec :: Int -> 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
        (String
def, String
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
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
def) (String -> IO ()
cb String
def)
        String -> IO ()
checkPipe String
pipe
        Handle
h <- String -> IOMode -> IO Handle
openFile String
pipe IOMode
ReadWriteMode
        IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Handle -> IO String
hGetLine Handle
h IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
cb)
      where
        split :: a -> [a] -> ([a], [a])
split a
c [a]
xs | a
c 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
        FileStatus
status <- String -> IO FileStatus
getFileStatus String
file
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileStatus -> Bool
isNamedPipe FileStatus
status) IO ()
waitForPipe
    where waitForPipe :: IO ()
waitForPipe = Int -> IO ()
threadDelay Int
1000000 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
checkPipe String
file