diff options
author | Pavan Rikhi <pavan.rikhi@gmail.com> | 2018-03-17 22:48:24 -0400 |
---|---|---|
committer | jao <jao@gnu.org> | 2018-11-21 21:41:35 +0000 |
commit | 4d1402a1a7d87767267d48a77998e4fb13395b31 (patch) | |
tree | 17fd6160dc1fa9c8a0676a94bcf8d19b551c655c /src/Xmobar/Plugins/MarqueePipeReader.hs | |
parent | 9e2a5c7daddf683d4be7c318aefed3da3ea7a89a (diff) | |
download | xmobar-4d1402a1a7d87767267d48a77998e4fb13395b31.tar.gz xmobar-4d1402a1a7d87767267d48a77998e4fb13395b31.tar.bz2 |
Split Modules into Library & Executable Structure
Move the Main module to a new `app` directory. All other modules have
been nested under the `Xmobar` name. Lots of module headers & imports
were updated.
Diffstat (limited to 'src/Xmobar/Plugins/MarqueePipeReader.hs')
-rw-r--r-- | src/Xmobar/Plugins/MarqueePipeReader.hs | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/MarqueePipeReader.hs b/src/Xmobar/Plugins/MarqueePipeReader.hs new file mode 100644 index 0000000..ad6f27f --- /dev/null +++ b/src/Xmobar/Plugins/MarqueePipeReader.hs @@ -0,0 +1,70 @@ +----------------------------------------------------------------------------- +-- | +-- 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 where + +import System.IO (openFile, IOMode(ReadWriteMode), Handle) +import Xmobar.Environment +import Xmobar.Plugins (tenthSeconds, Exec(alias, start), hGetLineSafe) +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) +import Control.Applicative ((<$>)) + +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 (Read, Show) + +instance Exec MarqueePipeReader where + alias (MarqueePipeReader _ _ a) = a + start (MarqueePipeReader p (len, rate, sep) _) cb = do + (def, pipe) <- split ':' <$> expandEnv p + unless (null def) (cb def) + checkPipe pipe + h <- openFile pipe ReadWriteMode + line <- hGetLineSafe h + chan <- atomically newTChan + forkIO $ writer (toInfTxt line sep) sep len rate chan cb + forever $ pipeToChan h chan + where + split c xs | c `elem` xs = let (pre, post) = span (c /=) xs + in (pre, dropWhile (c ==) post) + | otherwise = ([], xs) + +pipeToChan :: Handle -> TChan String -> IO () +pipeToChan h chan = do + line <- hGetLineSafe h + atomically $ writeTChan chan line + +writer :: String -> Separator -> Length -> Rate -> TChan String -> (String -> IO ()) -> IO () +writer txt sep len rate chan cb = do + cb (take len txt) + mbnext <- atomically $ tryReadTChan chan + case mbnext of + Just new -> writer (toInfTxt new sep) sep len rate chan cb + Nothing -> tenthSeconds rate >> writer (drop 1 txt) sep len rate chan cb + +toInfTxt :: String -> String -> String +toInfTxt line sep = concat (repeat $ line ++ " " ++ sep ++ " ") + +checkPipe :: FilePath -> IO () +checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do + status <- getFileStatus file + unless (isNamedPipe status) waitForPipe + where waitForPipe = threadDelay 1000 >> checkPipe file |