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]
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
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) <- forall {a}. Eq a => a -> [a] -> ([a], [a])
split Char
':' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
expandEnv String
p
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (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 <- forall a. STM a -> IO a
atomically forall a. STM (TChan a)
newTChan
IO () -> IO ThreadId
forkIO 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
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs = let ([a]
pre, [a]
post) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a
c forall a. Eq a => a -> a -> Bool
/=) [a]
xs
in ([a]
pre, forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a
c 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
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ 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 (forall a. Int -> [a] -> [a]
take Int
len String
txt)
Maybe String
mbnext <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String
-> String
-> Int
-> Int
-> TChan String
-> (String -> IO ())
-> IO ()
writer (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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a]
repeat forall a b. (a -> b) -> a -> b
$ String
line forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
sep forall a. [a] -> [a] -> [a]
++ String
" ")
checkPipe :: FilePath -> IO ()
checkPipe :: String -> IO ()
checkPipe String
file = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
_) -> IO ()
waitForPipe) forall a b. (a -> b) -> a -> b
$ do
FileStatus
status <- String -> IO FileStatus
getFileStatus String
file
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileStatus -> Bool
isNamedPipe FileStatus
status) IO ()
waitForPipe
where waitForPipe :: IO ()
waitForPipe = Int -> IO ()
threadDelay Int
1000 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
checkPipe String
file