diff --git a/src/QBar/Blocks/Pipe.hs b/src/QBar/Blocks/Pipe.hs index 08b1adef01a05c4c29208186f914a1f85b0173af..8c783219ad7a7b64bccee685e80ed872bc3071e6 100644 --- a/src/QBar/Blocks/Pipe.hs +++ b/src/QBar/Blocks/Pipe.hs @@ -16,19 +16,19 @@ import System.IO runPipeClient :: Bool -> MainOptions -> IO () runPipeClient enableEvents mainOptions = do (output, input) <- spawn unbounded - hostTask <- async $ sendBlockStream (addBlock $ pipeBlock enableEvents $ fromInput input) mainOptions + hostTask <- async $ sendBlockStream (addBlock $ pipeBlock $ 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 -> Producer String BarIO () -> PushBlock -pipeBlock enableEvents source = PushMode <$ source >-> 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" + -- |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 :: Producer String BarIO () -> PushBlock + pipeBlock source = PushMode <$ source >-> 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"