From 6e124f046b5b92dd3cdfc4a4ea337e3aca4c025d Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
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/Xmobar')

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