diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs index 0957f82573a8e02159e372114220034adda66e1d..530a297d0347121e63dcadaece093e809e96ee9f 100644 --- a/src/QBar/Core.hs +++ b/src/QBar/Core.hs @@ -223,18 +223,24 @@ blockScript path = forever $ updateBlock =<< (lift blockScriptAction) -- The exit code is used for i3blocks signaling but ignored here (=not implemented) -- I am trying to replace i3blocks scripts with native haskell blocks, so I do not need it (exitCode, output) <- liftIO $ readProcessStdout $ shell path - case exitCode of - ExitSuccess -> return $ case map E.decodeUtf8 (C8.lines output) of - -- TODO: Fix this, but how? - -- PangoSegments cannot have external formatting, so either allow that here, - -- or duplicate the function into pango and nonPango variants. - -- (text:short:color:_) -> setColor color $ shortText short $ createScriptBlock text - (text:short:_) -> shortText ?~ pangoText short $ createScriptBlock text - (text:_) -> createScriptBlock text - [] -> createScriptBlock "-" - (ExitFailure nr) -> return $ mkErrorOutput $ "[" <> T.pack (show nr) <> "]" - createScriptBlock :: T.Text -> BlockOutput - createScriptBlock text = blockName ?~ T.pack path $ mkBlockOutput . pangoText $ text + return $ case exitCode of + ExitSuccess -> createScriptBlock False normalImportant output + (ExitFailure nr) -> case nr of + 27 -> createScriptBlock False warnImportant output + 28 -> createScriptBlock False errorImportant output + 29 -> createScriptBlock False criticalImportant output + 30 -> createScriptBlock True normalImportant output + 31 -> createScriptBlock True warnImportant output + 32 -> createScriptBlock True errorImportant output + 33 -> createScriptBlock True criticalImportant output + _ -> mkErrorOutput $ "[" <> T.pack (show nr) <> "]" + createScriptBlock :: Bool -> Importance -> C8.ByteString -> BlockOutput + createScriptBlock active importance output = case map E.decodeUtf8 (C8.lines output) of + (text:short:_) -> shortText ?~ normalText short $ createScriptBlock' active importance text + (text:_) -> createScriptBlock' active importance text + [] -> createScriptBlock' active importance "-" + createScriptBlock' :: Bool -> Importance -> T.Text -> BlockOutput + createScriptBlock' active importance text = blockName ?~ T.pack path $ mkBlockOutput $ mkText active importance text startPersistentBlockScript :: FilePath -> PushBlock -- The outer catchP only catches errors that occur during process creation @@ -258,7 +264,7 @@ startPersistentBlockScript path = catchP startScriptProcess handleError blockFromHandle :: Handle -> PushBlock blockFromHandle handle = forever $ do line <- liftIO $ TIO.hGetLine handle - updateBlock $ mkBlockOutput . pangoText $ line + updateBlock $ mkBlockOutput . normalText $ line lift updateBar addBlock :: IsCachableBlock a => a -> BarIO ()