Skip to content
Snippets Groups Projects
Commit 0e7c426b authored by Jens Nolte's avatar Jens Nolte
Browse files

Terminate 'qbar pipe' on EOF

parent d1084116
No related branches found
No related tags found
No related merge requests found
module QBar.Blocks.Pipe where module QBar.Blocks.Pipe where
import QBar.BlockOutput import QBar.BlockOutput
import QBar.ControlSocket
import QBar.Core import QBar.Core
import Control.Concurrent.Async
import Data.Aeson (encode) import Data.Aeson (encode)
import qualified Data.ByteString.Lazy.Char8 as BSC import qualified Data.ByteString.Lazy.Char8 as BSC
import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy as T
import Pipes import Pipes
import Pipes.Concurrent
import qualified Pipes.Prelude as PP import qualified Pipes.Prelude as PP
import System.IO 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. -- |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 :: Bool -> Producer String BarIO () -> PushBlock
pipeBlock enableEvents = PushMode <$ PP.stdinLn >-> PP.map stringToState pipeBlock enableEvents source = PushMode <$ source >-> PP.map stringToState
where where
stringToState :: String -> BlockState stringToState :: String -> BlockState
stringToState = attachHandler . mkBlockOutput . normalText . T.pack stringToState = attachHandler . mkBlockOutput . normalText . T.pack
......
...@@ -40,7 +40,7 @@ barCommandParser :: Parser (MainOptions -> IO ()) ...@@ -40,7 +40,7 @@ barCommandParser :: Parser (MainOptions -> IO ())
barCommandParser = hsubparser ( 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 "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 "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 "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 "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'.")) command "rainbow" (info (pure $ sendIpc . SetTheme $ "rainbow") (progDesc "Shortcut for 'qbar theme rainbow'."))
...@@ -49,10 +49,10 @@ barCommandParser = hsubparser ( ...@@ -49,10 +49,10 @@ barCommandParser = hsubparser (
themeCommandParser :: Parser (MainOptions -> IO ()) themeCommandParser :: Parser (MainOptions -> IO ())
themeCommandParser = sendIpc . SetTheme <$> strArgument (metavar "THEME" <> completeWith (map T.unpack themeNames)) themeCommandParser = sendIpc . SetTheme <$> strArgument (metavar "THEME" <> completeWith (map T.unpack themeNames))
pipeBlockParser :: Parser (BarIO ()) pipeClientParser :: Parser (MainOptions -> IO ())
pipeBlockParser = do pipeClientParser = do
events <- switch $ long "events" <> short 'e' <> help "Also encode events to stdout. Every event will be a JSON-encoded line." 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 :: Parser (BarIO ())
barConfigurationParser = do barConfigurationParser = do
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment