diff --git a/src/QBar/Blocks/Pipe.hs b/src/QBar/Blocks/Pipe.hs new file mode 100644 index 0000000000000000000000000000000000000000..54e4d35bf9ddd6fcd772e6e4885ea3b0608b8d4b --- /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 d23996a80873e27ac855e5082cbead7ba0f21dc5..1d6c7e20d8963fc086be669e16ce72a1c5295bab 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 3638ae9ec96e7454afb9456fcc14880e82eda14c..85cd59976b56f3acd3ef3e02ed327f4f1298a0c0 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)