diff --git a/src/QBar/Blocks/Pipe.hs b/src/QBar/Blocks/Pipe.hs index 54e4d35bf9ddd6fcd772e6e4885ea3b0608b8d4b..08b1adef01a05c4c29208186f914a1f85b0173af 100644 --- a/src/QBar/Blocks/Pipe.hs +++ b/src/QBar/Blocks/Pipe.hs @@ -1,18 +1,28 @@ module QBar.Blocks.Pipe where import QBar.BlockOutput +import QBar.ControlSocket import QBar.Core +import Control.Concurrent.Async import Data.Aeson (encode) import qualified Data.ByteString.Lazy.Char8 as BSC import qualified Data.Text.Lazy as T import Pipes +import Pipes.Concurrent import qualified Pipes.Prelude as PP import System.IO +runPipeClient :: Bool -> MainOptions -> IO () +runPipeClient enableEvents mainOptions = do + (output, input) <- spawn unbounded + hostTask <- async $ sendBlockStream (addBlock $ pipeBlock enableEvents $ fromInput input) mainOptions + inputTask <- async $ runEffect $ PP.stdinLn >-> toOutput output + void $ waitEitherCancel hostTask inputTask + -- |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 +pipeBlock :: Bool -> Producer String BarIO () -> PushBlock +pipeBlock enableEvents source = PushMode <$ source >-> PP.map stringToState where stringToState :: String -> BlockState stringToState = attachHandler . mkBlockOutput . normalText . T.pack diff --git a/src/QBar/Cli.hs b/src/QBar/Cli.hs index 779610e7f90009e863ddefcd656164e99b9e0f87..74ed961d50958b204731245a2dcbaa87e2e2fdaf 100644 --- a/src/QBar/Cli.hs +++ b/src/QBar/Cli.hs @@ -40,7 +40,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 "pipe" (info pipeClientParser (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'.")) @@ -49,10 +49,10 @@ barCommandParser = hsubparser ( themeCommandParser :: Parser (MainOptions -> IO ()) themeCommandParser = sendIpc . SetTheme <$> strArgument (metavar "THEME" <> completeWith (map T.unpack themeNames)) -pipeBlockParser :: Parser (BarIO ()) -pipeBlockParser = do +pipeClientParser :: Parser (MainOptions -> IO ()) +pipeClientParser = 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 + pure $ runPipeClient events barConfigurationParser :: Parser (BarIO ()) barConfigurationParser = do