From a1e5557f65762a01b17b9ae51e96330ecc4f8ce3 Mon Sep 17 00:00:00 2001
From: Benjamin Koch <snowball@c3pb.de>
Date: Sun, 13 Dec 2020 04:44:51 +0100
Subject: [PATCH] Provide click events to scripts
---
src/QBar/Blocks/Script.hs | 40 +++++++++++++++++++++++++++++----------
src/QBar/Cli.hs | 3 ++-
2 files changed, 32 insertions(+), 11 deletions(-)
diff --git a/src/QBar/Blocks/Script.hs b/src/QBar/Blocks/Script.hs
index d274d0a..5a615f7 100644
--- a/src/QBar/Blocks/Script.hs
+++ b/src/QBar/Blocks/Script.hs
@@ -7,6 +7,7 @@ import QBar.TagParser
import QBar.Time
import Control.Exception (IOException)
+import Data.Aeson (encode)
import qualified Data.ByteString.Lazy.Char8 as C8
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as E
@@ -14,9 +15,9 @@ import qualified Data.Text.Lazy.IO as TIO
import Pipes
import Pipes.Safe (catchP)
import System.Exit
-import System.IO
+import System.IO hiding (stdin, stdout)
import System.Process.Typed (Process, shell, setStdin, setStdout,
- getStdout, closed, createPipe, readProcessStdout, startProcess, stopProcess)
+ getStdin, getStdout, closed, createPipe, readProcessStdout, startProcess, stopProcess)
pollScriptBlock :: Interval -> FilePath -> Block
@@ -36,9 +37,9 @@ pollScriptBlock interval path = runPollBlock' interval $ forever $ yieldBlockUpd
(text:_) -> parseTags' text
[] -> emptyBlock
-scriptBlock :: FilePath -> Block
+scriptBlock :: Bool -> FilePath -> Block
-- The outer catchP only catches errors that occur during process creation
-scriptBlock path = catchP startScriptProcess handleError
+scriptBlock clickEvents path = catchP startScriptProcess handleError
where
handleError :: IOException -> Block
handleError e = do
@@ -49,13 +50,32 @@ scriptBlock path = catchP startScriptProcess handleError
stopProcess process
handleError e
startScriptProcess :: Block
- startScriptProcess = do
+ startScriptProcess = if clickEvents
+ then startScriptProcessWithEvents
+ else startScriptProcessNoEvents
+ startScriptProcessNoEvents :: Block
+ startScriptProcessNoEvents = do
let processConfig = setStdin closed $ setStdout createPipe $ shell path
process <- startProcess processConfig
-- The inner catchP catches errors that happen after the process has been created
-- This handler will also make sure the process is stopped
- catchP (blockFromHandle $ getStdout process) (handleErrorWithProcess process)
- blockFromHandle :: Handle -> Block
- blockFromHandle handle = forever $ do
- line <- liftIO $ TIO.hGetLine handle
- pushBlockUpdate $ parseTags' line
+ catchP (blockFromHandle Nothing $ getStdout process) (handleErrorWithProcess process)
+ startScriptProcessWithEvents :: Block
+ startScriptProcessWithEvents = do
+ let processConfig = setStdin createPipe $ setStdout createPipe $ shell path
+ process <- startProcess processConfig
+ -- The inner catchP catches errors that happen after the process has been created
+ -- This handler will also make sure the process is stopped
+ blockFromHandle (Just $ getStdin process) (getStdout process)
+ `catchP` handleErrorWithProcess process
+ blockFromHandle :: Maybe Handle -> Handle -> Block
+ blockFromHandle stdin stdout = forever $ do
+ line <- liftIO $ TIO.hGetLine stdout
+ let blockOutput = parseTags' line
+ case stdin of
+ Nothing -> pushBlockUpdate blockOutput
+ Just h -> pushBlockUpdate' (handleClick h) blockOutput
+ handleClick :: Handle -> BlockEventHandler
+ handleClick stdin ev = liftIO $ do
+ C8.hPutStrLn stdin $ encode ev
+ hFlush stdin
diff --git a/src/QBar/Cli.hs b/src/QBar/Cli.hs
index 35f4f0c..562f74b 100644
--- a/src/QBar/Cli.hs
+++ b/src/QBar/Cli.hs
@@ -111,5 +111,6 @@ scriptBlockParser = helper <*> do
metavar "SECONDS" <>
(help $ "Interval to use for --poll mode (default: " <> humanReadableInterval defaultInterval <> ")")
))
+ clickEvents <- switch $ long "events" <> short 'e' <> help "Send click events to stdin of the script"
script <- strArgument (metavar "SCRIPT" <> help "The script that will be executed with a shell.")
- return $ (if poll then addBlock . pollScriptBlock pollInterval else addBlock . scriptBlock) script
+ return $ (if poll then addBlock . pollScriptBlock pollInterval else addBlock . scriptBlock clickEvents) script
--
GitLab