swaybar-protocol: output with colors and actions

1 files changed, 44 insertions, 10 deletions

diff --git a/src/Xmobar/Text/Swaybar.hs b/src/Xmobar/Text/Swaybar.hs
index a4ee306..0a7b8af 100644
--- a/src/Xmobar/Text/Swaybar.hs
+++ b/src/Xmobar/Text/Swaybar.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveGeneric #-}
+
 ------------------------------------------------------------------------------
 -- |
 -- Module: Xmobar.Text.Swaybar
@@ -16,24 +18,56 @@
 
 module Xmobar.Text.Swaybar (preamble, formatSwaybar) where
 
-import Data.List (intercalate)
+import Data.Aeson
+import Data.ByteString.Lazy.UTF8 (toString)
+
+import GHC.Generics
 
 import Xmobar.Config.Types (Config)
 
 import Xmobar.Run.Parsers ( Segment
                           , Widget(..)
-                          -- , tColorsString
-                          -- , colorComponents
+                          , tColorsString
+                          , colorComponents
                           )
 
+data Preamble =
+  Preamble {version :: !Int, click_events :: Bool} deriving (Eq,Show,Generic)
+
+asString :: ToJSON a => a -> String
+asString = toString . encode
+
 preamble :: String
-preamble = "{\"version\": 1, \"click_events\": true}\x0A["
+preamble = (asString $ Preamble { version = 1, click_events = True }) ++ "\x0A["
+
+data Block =
+  Block { full_text :: !String
+        , color :: !String
+        , background :: !String
+        , separator :: !Bool
+        , separator_block_width :: !Int
+        , name :: !String
+        } deriving (Eq,Show,Generic)
+
+defaultBlock :: Block
+defaultBlock = Block { full_text = ""
+                     , name = ""
+                     , color = ""
+                     , background = ""
+                     , separator = False
+                     , separator_block_width = 0}
+
+instance ToJSON Preamble
+instance ToJSON Block
 
-formatSwaybar' :: Config -> Segment -> String
-formatSwaybar' _conf (Text txt, _, _, _) =
-  "{\"full_text\":\"" ++ txt ++ "\"}"
-formatSwaybar' _ _ = ""
+formatSwaybar' :: Config -> Segment -> Block
+formatSwaybar' conf (Text txt, info, _, as) =
+  defaultBlock {full_text = txt , color = fg , background = bg , name = show as}
+  where (fg, bg) = colorComponents conf (tColorsString info)
+formatSwaybar' conf (Hspace n, info, i, a) =
+  formatSwaybar' conf (Text (replicate (fromIntegral n) ' '), info, i, a)
+formatSwaybar' _ _ = defaultBlock
 
 formatSwaybar :: Config -> [Segment] -> String
-formatSwaybar conf segs =
-  "[" ++ intercalate "," (map (formatSwaybar' conf) segs) ++ "],"
+formatSwaybar conf segs = asString elems ++ ","
+  where elems = filter (not . null . full_text) (map (formatSwaybar' conf) segs)