From 006ceaa296c21b1d77fee23e3ef68ec1ff08141a Mon Sep 17 00:00:00 2001
From: Jens Nolte <jens@nightmarestudio.de>
Date: Tue, 18 Feb 2020 18:01:56 +0100
Subject: [PATCH] Implement pipe block
---
src/QBar/Blocks/Pipe.hs | 24 ++++++++++++++++++++++++
src/QBar/Cli.hs | 7 +++++++
src/QBar/Core.hs | 3 +++
3 files changed, 34 insertions(+)
create mode 100644 src/QBar/Blocks/Pipe.hs
diff --git a/src/QBar/Blocks/Pipe.hs b/src/QBar/Blocks/Pipe.hs
new file mode 100644
index 0000000..54e4d35
--- /dev/null
+++ b/src/QBar/Blocks/Pipe.hs
@@ -0,0 +1,24 @@
+module QBar.Blocks.Pipe where
+
+import QBar.BlockOutput
+import QBar.Core
+
+import Data.Aeson (encode)
+import qualified Data.ByteString.Lazy.Char8 as BSC
+import qualified Data.Text.Lazy as T
+import Pipes
+import qualified Pipes.Prelude as PP
+import System.IO
+
+-- |Special block that reads the processes stdin line-by-line and shows the latest line in the block. Must never be used in a 'server' process or when stdin/stdout is used in another way.
+pipeBlock :: Bool -> PushBlock
+pipeBlock enableEvents = PushMode <$ PP.stdinLn >-> PP.map stringToState
+ where
+ stringToState :: String -> BlockState
+ stringToState = attachHandler . mkBlockOutput . normalText . T.pack
+ attachHandler :: BlockOutput -> BlockState
+ attachHandler = if enableEvents then mkBlockState' pipeBlockName handler else mkBlockState
+ handler :: BlockEventHandler
+ handler event = liftIO $ BSC.hPutStrLn stderr $ encode event
+ pipeBlockName :: Text
+ pipeBlockName = "pipe"
diff --git a/src/QBar/Cli.hs b/src/QBar/Cli.hs
index d23996a..1d6c7e2 100644
--- a/src/QBar/Cli.hs
+++ b/src/QBar/Cli.hs
@@ -2,6 +2,7 @@
module QBar.Cli where
+import QBar.Blocks.Pipe
import QBar.ControlSocket
import QBar.Core
import QBar.DefaultConfig
@@ -38,6 +39,7 @@ barCommandParser :: Parser (MainOptions -> IO ())
barCommandParser = hsubparser (
command "server" (info (runBarServer <$> barConfigurationParser) (progDesc "Start a new qbar server. Should be called by swaybar, i3bar or or another i3bar-protocol compatible host process.")) <>
command "connect" (info (sendBlockStream <$> barConfigurationParser) (progDesc "Run blocks on this process but display them on the qbar server.")) <>
+ command "pipe" (info (sendBlockStream <$> pipeBlockParser) (progDesc "Redirects the stdin of this process to a running bar.")) <>
command "theme" (info themeCommandParser (progDesc "Change the theme of the running qbar server.")) <>
command "default" (info (pure $ sendIpc . SetTheme $ "default") (progDesc "Shortcut for 'qbar theme default'.")) <>
command "rainbow" (info (pure $ sendIpc . SetTheme $ "rainbow") (progDesc "Shortcut for 'qbar theme rainbow'."))
@@ -46,6 +48,11 @@ barCommandParser = hsubparser (
themeCommandParser :: Parser (MainOptions -> IO ())
themeCommandParser = sendIpc . SetTheme <$> strArgument (metavar "THEME" <> completeWith (map T.unpack themeNames))
+pipeBlockParser :: Parser (BarIO ())
+pipeBlockParser = do
+ events <- switch $ long "events" <> short 'e' <> help "Also encode events to stdout. Every event will be a JSON-encoded line."
+ pure $ addBlock $ pipeBlock events
+
barConfigurationParser :: Parser (BarIO ())
barConfigurationParser = do
blocks <- many $ hsubparser (
diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs
index 3638ae9..85cd599 100644
--- a/src/QBar/Core.hs
+++ b/src/QBar/Core.hs
@@ -134,6 +134,9 @@ updateBlock' blockEventHandler blockOutput = liftBlock . yield $ Just (blockOutp
mkBlockState :: BlockOutput -> BlockState
mkBlockState blockOutput = Just (blockOutput, Nothing)
+mkBlockState' :: Text -> BlockEventHandler -> BlockOutput -> BlockState
+mkBlockState' newBlockName blockEventHandler blockOutput = Just (blockOutput {_blockName = Just newBlockName}, Just blockEventHandler)
+
updateEventHandler :: BlockEventHandler -> BlockState -> BlockState
updateEventHandler _ Nothing = Nothing
updateEventHandler eventHandler (Just (blockOutput, _)) = Just (blockOutput, Just eventHandler)
--
GitLab