diff options
author | jao <jao@gnu.org> | 2018-11-25 15:10:29 +0000 |
---|---|---|
committer | jao <jao@gnu.org> | 2018-11-25 15:10:29 +0000 |
commit | 77df1ac30fa7af5948f7ff64f5fee9aed64552b3 (patch) | |
tree | 647a4eb67ff1c293a5c530538ee88fc0093b577a /src/Xmobar/Plugins/PipeReader.hs | |
parent | e0d6da82de8d0d1cef98896164c6016b84e47068 (diff) | |
download | xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.gz xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.bz2 |
Back to app/src, since it seems they're the default convention for stack
Diffstat (limited to 'src/Xmobar/Plugins/PipeReader.hs')
-rw-r--r-- | src/Xmobar/Plugins/PipeReader.hs | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/PipeReader.hs b/src/Xmobar/Plugins/PipeReader.hs new file mode 100644 index 0000000..f18b9cb --- /dev/null +++ b/src/Xmobar/Plugins/PipeReader.hs @@ -0,0 +1,48 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.PipeReader +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin for reading from named pipes +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.PipeReader(PipeReader(..)) where + +import System.IO +import Xmobar.Utils(hGetLineSafe) +import Xmobar.Run.Commands(Exec(..)) +import Xmobar.System.Environment(expandEnv) +import System.Posix.Files +import Control.Concurrent(threadDelay) +import Control.Exception +import Control.Monad(forever, unless) +import Control.Applicative ((<$>)) + +data PipeReader = PipeReader String String + deriving (Read, Show) + +instance Exec PipeReader where + alias (PipeReader _ a) = a + start (PipeReader p _) cb = do + (def, pipe) <- split ':' <$> expandEnv p + unless (null def) (cb def) + checkPipe pipe + h <- openFile pipe ReadWriteMode + forever (hGetLineSafe h >>= cb) + where + split c xs | c `elem` xs = let (pre, post) = span (c /=) xs + in (pre, dropWhile (c ==) post) + | otherwise = ([], xs) + +checkPipe :: FilePath -> IO () +checkPipe file = + handle (\(SomeException _) -> waitForPipe) $ do + status <- getFileStatus file + unless (isNamedPipe status) waitForPipe + where waitForPipe = threadDelay 1000000 >> checkPipe file |