1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
-----------------------------------------------------------------------------
-- |
-- 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 Plugins.MarqueePipeReader where
import System.IO (openFile, IOMode(ReadWriteMode), Handle)
import 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)
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
let (def, pipe) = split ':' 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
|
