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
readListPrec :: ReadPrec [MarqueePipeReader]
$creadListPrec :: ReadPrec [MarqueePipeReader]
readPrec :: ReadPrec MarqueePipeReader
$creadPrec :: ReadPrec MarqueePipeReader
readList :: ReadS [MarqueePipeReader]
$creadList :: ReadS [MarqueePipeReader]
readsPrec :: Int -> ReadS MarqueePipeReader
$creadsPrec :: Int -> ReadS 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
showList :: [MarqueePipeReader] -> ShowS
$cshowList :: [MarqueePipeReader] -> ShowS
show :: MarqueePipeReader -> String
$cshow :: MarqueePipeReader -> String
showsPrec :: Int -> MarqueePipeReader -> ShowS
$cshowsPrec :: Int -> 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
(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
String
line <- Handle -> IO String
hGetLine Handle
h
TChan String
chan <- STM (TChan String) -> IO (TChan String)
forall a. STM a -> IO a
atomically STM (TChan String)
forall a. STM (TChan a)
newTChan
IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ String
-> String
-> Int
-> Int
-> TChan String
-> (String -> IO ())
-> IO ()
writer (String -> ShowS
toInfTxt String
line String
sep) String
sep Int
len Int
rate TChan String
chan String -> IO ()
cb
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> TChan String -> IO ()
pipeToChan Handle
h TChan String
chan
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)
pipeToChan :: Handle -> TChan String -> IO ()
pipeToChan :: Handle -> TChan String -> IO ()
pipeToChan Handle
h TChan String
chan = do
String
line <- Handle -> IO String
hGetLine Handle
h
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan String -> String -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan String
chan String
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)
Maybe String
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 Maybe String
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 (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 = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String]
forall a. a -> [a]
repeat (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ 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
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
1000 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
checkPipe String
file