swaybar-protocol: output with colors and actions

2 files changed, 63 insertions, 28 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)
diff --git a/xmobar.cabal b/xmobar.cabal
index 373ba83..69de4e8 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -185,24 +185,25 @@ library
     ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind
 
     build-depends:
-      base >= 4.11.0 && < 4.16,
-      containers,
-      regex-compat,
-      process,
-      old-locale,
-      bytestring >= 0.10.8.2,
-      directory,
-      unix,
-      time,
-      filepath,
-      transformers,
-      X11 >= 1.6.1,
-      mtl >= 2.1 && < 2.3,
-      parsec == 3.1.*,
-      parsec-numbers >= 0.1.0,
-      stm >= 2.3 && < 2.6,
-      extensible-exceptions == 0.1.*,
-      async
+                  X11 >= 1.6.1,
+                  aeson >= 2.0.3.0,
+                  async,
+                  base >= 4.11.0 && < 4.16,
+                  bytestring >= 0.10.8.2,
+                  containers,
+                  directory,
+                  extensible-exceptions == 0.1.*,
+                  filepath,
+                  mtl >= 2.1 && < 2.3,
+                  old-locale,
+                  parsec == 3.1.*,
+                  parsec-numbers >= 0.1.0,
+                  process,
+                  regex-compat,
+                  stm >= 2.3 && < 2.6,
+                  time,
+                  transformers,
+                  unix
 
     if impl(ghc < 8.0.2)
        -- Disable building with GHC before 8.0.2.