module Xmobar.Plugins.MarqueePipeReader(MarqueePipeReader(..)) where
import System.IO (openFile, IOMode(ReadWriteMode), Handle, hGetLine)
import Xmobar.System.Environment
import Xmobar.Run.Exec(Exec(alias, start), tenthSeconds)
import System.Posix.Files (getFileStatus, isNamedPipe)
import Control.Concurrent(forkIO, threadDelay)
import Control.Concurrent.STM (TChan, atomically, writeTChan, tryReadTChan, newTChan)
import Control.Exception
import Control.Monad(forever, unless)
type Length = Int
type Rate = Int
type Separator = String
data MarqueePipeReader = MarqueePipeReader String (Length, Rate, Separator) String
deriving (ReadPrec [MarqueePipeReader]
ReadPrec MarqueePipeReader
Int -> ReadS MarqueePipeReader
ReadS [MarqueePipeReader]
(Int -> ReadS MarqueePipeReader)
-> ReadS [MarqueePipeReader]
-> ReadPrec MarqueePipeReader
-> ReadPrec [MarqueePipeReader]
-> Read MarqueePipeReader
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MarqueePipeReader
readsPrec :: Int -> ReadS MarqueePipeReader
$creadList :: ReadS [MarqueePipeReader]
readList :: ReadS [MarqueePipeReader]
$creadPrec :: ReadPrec MarqueePipeReader
readPrec :: ReadPrec MarqueePipeReader
$creadListPrec :: ReadPrec [MarqueePipeReader]
readListPrec :: ReadPrec [MarqueePipeReader]
Read, Int -> MarqueePipeReader -> ShowS
[MarqueePipeReader] -> ShowS
MarqueePipeReader -> String
(Int -> MarqueePipeReader -> ShowS)
-> (MarqueePipeReader -> String)
-> ([MarqueePipeReader] -> ShowS)
-> Show MarqueePipeReader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarqueePipeReader -> ShowS
showsPrec :: Int -> MarqueePipeReader -> ShowS
$cshow :: MarqueePipeReader -> String
show :: MarqueePipeReader -> String
$cshowList :: [MarqueePipeReader] -> ShowS
showList :: [MarqueePipeReader] -> ShowS
Show)
instance Exec MarqueePipeReader where
alias :: MarqueePipeReader -> String
alias (MarqueePipeReader String
_ (Int, Int, String)
_ String
a) = String
a
start :: MarqueePipeReader -> (String -> IO ()) -> IO ()
start (MarqueePipeReader String
p (Int
len, Int
rate, String
sep) 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
line <- hGetLine h
chan <- atomically newTChan
forkIO $ writer (toInfTxt line sep) sep len rate chan cb
forever $ pipeToChan h chan
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)
pipeToChan :: Handle -> TChan String -> IO ()
pipeToChan :: Handle -> TChan String -> IO ()
pipeToChan Handle
h TChan String
chan = do
line <- Handle -> IO String
hGetLine Handle
h
atomically $ writeTChan chan line
writer :: String -> Separator -> Length -> Rate -> TChan String -> (String -> IO ()) -> IO ()
writer :: String
-> String
-> Int
-> Int
-> TChan String
-> (String -> IO ())
-> IO ()
writer String
txt String
sep Int
len Int
rate TChan String
chan String -> IO ()
cb = do
String -> IO ()
cb (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
len String
txt)
mbnext <- STM (Maybe String) -> IO (Maybe String)
forall a. STM a -> IO a
atomically (STM (Maybe String) -> IO (Maybe String))
-> STM (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ TChan String -> STM (Maybe String)
forall a. TChan a -> STM (Maybe a)
tryReadTChan TChan String
chan
case mbnext of
Just String
new -> String
-> String
-> Int
-> Int
-> TChan String
-> (String -> IO ())
-> IO ()
writer (String -> ShowS
toInfTxt String
new String
sep) String
sep Int
len Int
rate TChan String
chan String -> IO ()
cb
Maybe String
Nothing -> Int -> IO ()
tenthSeconds Int
rate 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
-> String
-> Int
-> Int
-> TChan String
-> (String -> IO ())
-> IO ()
writer (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
txt) String
sep Int
len Int
rate TChan String
chan String -> IO ()
cb
toInfTxt :: String -> String -> String
toInfTxt :: String -> ShowS
toInfTxt String
line String
sep = ShowS
forall a. HasCallStack => [a] -> [a]
cycle (String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ")
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
1000 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