summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Xmobar/Config/Types.hs2
-rw-r--r--src/Xmobar/Text/Loop.hs15
-rw-r--r--src/Xmobar/Text/Output.hs36
-rw-r--r--src/Xmobar/Text/Swaybar.hs39
4 files changed, 67 insertions, 25 deletions
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) ++ "],"