diff --git a/src/QBar/Blocks/Script.hs b/src/QBar/Blocks/Script.hs index d274d0a12fd42a68c0c36ce7e680cc37b68f965e..5a615f7f0de459b1e73021f1e56dd5ded995455c 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 35f4f0cead1ba78b714fc4f6f99e6829db3f7a16..562f74beb4b92b8fef7b6dd2f9bbfef5e28ce351 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