-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.MarqueePipeReader
-- Copyright   :  (c) Reto Habluetzel
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A plugin for reading from named pipes for long texts with marquee
--
-----------------------------------------------------------------------------

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       -- length of the text to display
type Rate = Int         -- delay in tenth seconds
type Separator = String -- if text wraps around, use separator

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