From 6e124f046b5b92dd3cdfc4a4ea337e3aca4c025d Mon Sep 17 00:00:00 2001 From: jao Date: Fri, 4 Feb 2022 05:53:48 +0000 Subject: swaybar-protocol: very basic format --- src/Xmobar/Config/Types.hs | 2 +- src/Xmobar/Text/Loop.hs | 15 +++------------ src/Xmobar/Text/Output.hs | 36 ++++++++++++++++++++++++------------ src/Xmobar/Text/Swaybar.hs | 39 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 67 insertions(+), 25 deletions(-) create mode 100644 src/Xmobar/Text/Swaybar.hs (limited to 'src') diff --git a/src/Xmobar/Config/Types.hs b/src/Xmobar/Config/Types.hs index 7914a87..951759d 100644 --- a/src/Xmobar/Config/Types.hs +++ b/src/Xmobar/Config/Types.hs @@ -98,7 +98,7 @@ data Border = NoBorder | FullBM Int deriving ( Read, Show, Eq ) -data TextOutputFormat = Plain | Ansi | Pango deriving ( Read, Show, Eq ) +data TextOutputFormat = Plain | Ansi | Pango | Swaybar deriving (Read, Show, Eq) newtype SignalChan = SignalChan { unSignalChan :: Maybe (STM.TMVar SignalType) } diff --git a/src/Xmobar/Text/Loop.hs b/src/Xmobar/Text/Loop.hs index 2903aa9..89295fd 100644 --- a/src/Xmobar/Text/Loop.hs +++ b/src/Xmobar/Text/Loop.hs @@ -19,21 +19,19 @@ module Xmobar.Text.Loop (textLoop) where import Prelude hiding (lookup) import System.IO -import Control.Monad.Reader - import Control.Concurrent.STM import Xmobar.System.Signal import Xmobar.Config.Types (Config) import Xmobar.Run.Loop (loop) -import Xmobar.Run.Parsers (parseString) -import Xmobar.Text.Output (formatSegment) +import Xmobar.Text.Output (initLoop, format) -- | Starts the main event loop and threads textLoop :: Config -> IO () textLoop conf = do hSetBuffering stdin LineBuffering hSetBuffering stdout LineBuffering + initLoop conf loop conf (eventLoop conf) -- | Continuously wait for a signal from a thread or a interrupt handler @@ -47,11 +45,4 @@ eventLoop cfg signal tv = do updateString :: Config -> TVar [String] -> IO String updateString conf v = do s <- readTVarIO v - let l:c:r:_ = s ++ repeat "" - liftIO $ concat `fmap` mapM (parseStringAsText conf) [l, c, r] - -parseStringAsText :: Config -> String -> IO String -parseStringAsText c s = do - segments <- parseString c s - let txts = map (formatSegment c) segments - return (concat txts) + format conf (concat s) diff --git a/src/Xmobar/Text/Output.hs b/src/Xmobar/Text/Output.hs index 3754bd3..6aa1d56 100644 --- a/src/Xmobar/Text/Output.hs +++ b/src/Xmobar/Text/Output.hs @@ -9,33 +9,45 @@ -- Created: Fri Feb 4, 2022 01:10 -- -- --- Format segments emitted by Commands into output strings +-- Format strings emitted by Commands into output strings -- ------------------------------------------------------------------------------ -module Xmobar.Text.Output (formatSegment) where +module Xmobar.Text.Output (initLoop, format) where import Xmobar.Config.Types (Config(textOutputFormat), TextOutputFormat(..)) import Xmobar.Run.Parsers ( Segment , Widget(..) + , parseString , tColorsString , colorComponents) import Xmobar.Text.Ansi (withAnsiColor) import Xmobar.Text.Pango (withPangoColor) +import Xmobar.Text.Swaybar (formatSwaybar, preamble) -withColor :: TextOutputFormat -> (String, String) -> String -> String -withColor format color = case format of - Plain -> id - Ansi -> withAnsiColor color - Pango -> withPangoColor color +initLoop :: Config -> IO () +initLoop conf = case textOutputFormat conf of + Swaybar -> putStrLn preamble + _ -> return () +withColor :: TextOutputFormat -> (String, String) -> String -> String +withColor Ansi c = withAnsiColor c +withColor Pango c = withPangoColor c +withColor _ _ = id -formatSegment :: Config -> Segment -> String -formatSegment conf (Text s, info, _, _) = +formatWithColor :: Config -> Segment -> String +formatWithColor conf (Text s, info, _, _) = withColor (textOutputFormat conf) components s where components = colorComponents conf color color = tColorsString info -formatSegment conf (Hspace n, i, x, y) = - formatSegment conf (Text $ replicate (fromIntegral n) ' ', i, x, y) -formatSegment _ _ = "" +formatWithColor conf (Hspace n, i, x, y) = + formatWithColor conf (Text $ replicate (fromIntegral n) ' ', i, x, y) +formatWithColor _ _ = "" + +format :: Config -> String -> IO String +format conf s = do + segments <- parseString conf s + case textOutputFormat conf of + Swaybar -> return $ formatSwaybar conf segments + _ -> return (concatMap (formatWithColor conf) segments) diff --git a/src/Xmobar/Text/Swaybar.hs b/src/Xmobar/Text/Swaybar.hs new file mode 100644 index 0000000..a4ee306 --- /dev/null +++ b/src/Xmobar/Text/Swaybar.hs @@ -0,0 +1,39 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Text.Swaybar +-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Fri Feb 4, 2022 03:58 +-- +-- +-- Segment codification using swaybar-protocol JSON strings +-- +------------------------------------------------------------------------------ + +module Xmobar.Text.Swaybar (preamble, formatSwaybar) where + +import Data.List (intercalate) + +import Xmobar.Config.Types (Config) + +import Xmobar.Run.Parsers ( Segment + , Widget(..) + -- , tColorsString + -- , colorComponents + ) + +preamble :: String +preamble = "{\"version\": 1, \"click_events\": true}\x0A[" + +formatSwaybar' :: Config -> Segment -> String +formatSwaybar' _conf (Text txt, _, _, _) = + "{\"full_text\":\"" ++ txt ++ "\"}" +formatSwaybar' _ _ = "" + +formatSwaybar :: Config -> [Segment] -> String +formatSwaybar conf segs = + "[" ++ intercalate "," (map (formatSwaybar' conf) segs) ++ "]," -- cgit v1.2.3