refactor: split taffybar config into modules

Author: colonelpanic8

dotfiles/config/taffybar/TaffybarConfig/Config.hs

@@ -0,0 +1,35 @@
+module TaffybarConfig.Config
+  ( mkSimpleTaffyConfig,
+  )
+where
+
+import TaffybarConfig.Host (compactBarHosts, smallBarHosts)
+import TaffybarConfig.Widgets (clockWidget, endWidgetsForHost, startWidgetsForBackend)
+import System.Taffybar.Context (Backend)
+import System.Taffybar.SimpleConfig
+
+mkSimpleTaffyConfig :: String -> Backend -> [FilePath] -> SimpleTaffyConfig
+mkSimpleTaffyConfig hostName backend cssFiles =
+  defaultSimpleTaffyConfig
+    { startWidgets = startWidgetsForBackend backend,
+      centerWidgets = [clockWidget],
+      endWidgets = endWidgetsForHost hostName,
+      barLevels = Nothing,
+      barPosition = Top,
+      widgetSpacing = 0,
+      barPadding =
+        if hostName `elem` smallBarHosts
+          then 1
+          else
+            if hostName `elem` compactBarHosts
+              then 2
+              else 4,
+      barHeight =
+        if hostName `elem` smallBarHosts
+          then ScreenRatio $ 1 / 48
+          else
+            if hostName `elem` compactBarHosts
+              then ScreenRatio $ 1 / 40
+              else ScreenRatio $ 1 / 33,
+      cssPaths = cssFiles
+    }

dotfiles/config/taffybar/TaffybarConfig/Host.hs

@@ -0,0 +1,41 @@
+module TaffybarConfig.Host
+  ( compactBarHosts,
+    cssFilesForHost,
+    laptopHosts,
+    smallBarHosts,
+  )
+where
+
+import Data.Maybe (fromMaybe)
+
+-- NOTE: Keep `cssPaths` to a single entrypoint file per host. GTK's
+-- `cssProviderLoadFromPath` clears the provider before loading, so handing
+-- Taffybar multiple files here causes only the last file to take effect.
+defaultCssFiles :: [FilePath]
+defaultCssFiles = ["taffybar.css"]
+
+cssFilesByHostname :: [(String, [FilePath])]
+cssFilesByHostname =
+  [ ("ryzen-shine", ["ryzen-shine.css"]),
+    ("strixi-minaj", ["strixi-minaj.css"])
+  ]
+
+compactBarHosts :: [String]
+compactBarHosts =
+  ["ryzen-shine"]
+
+smallBarHosts :: [String]
+smallBarHosts =
+  ["strixi-minaj"]
+
+laptopHosts :: [String]
+laptopHosts =
+  [ "adell",
+    "stevie-nixos",
+    "strixi-minaj",
+    "jay-lenovo"
+  ]
+
+cssFilesForHost :: String -> [FilePath]
+cssFilesForHost hostName =
+  fromMaybe defaultCssFiles $ lookup hostName cssFilesByHostname

dotfiles/config/taffybar/TaffybarConfig/WidgetUtil.hs

@@ -0,0 +1,80 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module TaffybarConfig.WidgetUtil
+  ( decorateWithClassAndBox,
+    decorateWithClassAndBoxM,
+    setFixedLabelWidth,
+    setLabelAlignmentRecursively,
+    stackInPill,
+    usageLogoWidget,
+  )
+where
+
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.Foldable (for_)
+import Data.GI.Base (castTo)
+import Data.Int (Int32)
+import Data.Text (Text)
+import qualified GI.Gtk as Gtk
+import qualified GI.Pango as Pango
+import System.Environment.XDG.BaseDir (getUserConfigFile)
+import System.Taffybar.Context (TaffyIO)
+import System.Taffybar.Widget.Util
+  ( buildContentsBox,
+    pixbufNewFromFileAtScaleByHeight,
+    widgetSetClassGI,
+  )
+
+-- | Wrap the widget in a "TaffyBox" (via 'buildContentsBox') and add a CSS class.
+decorateWithClassAndBox :: (MonadIO m) => Text -> Gtk.Widget -> m Gtk.Widget
+decorateWithClassAndBox klass widget = do
+  boxed <- buildContentsBox widget
+  widgetSetClassGI boxed klass
+
+decorateWithClassAndBoxM :: (MonadIO m) => Text -> m Gtk.Widget -> m Gtk.Widget
+decorateWithClassAndBoxM klass builder =
+  builder >>= decorateWithClassAndBox klass
+
+forEachLabelRecursively :: Gtk.Widget -> (Gtk.Label -> IO ()) -> IO ()
+forEachLabelRecursively widget action = do
+  maybeLabel <- castTo Gtk.Label widget
+  for_ maybeLabel action
+
+  maybeContainer <- castTo Gtk.Container widget
+  case maybeContainer of
+    Just container ->
+      Gtk.containerGetChildren container >>= mapM_ (`forEachLabelRecursively` action)
+    Nothing -> pure ()
+
+setLabelAlignmentRecursively :: Float -> Gtk.Justification -> Gtk.Widget -> IO ()
+setLabelAlignmentRecursively xalign justify widget =
+  forEachLabelRecursively widget $ \label -> do
+    Gtk.labelSetXalign label xalign
+    Gtk.labelSetJustify label justify
+
+setFixedLabelWidth :: Int32 -> Gtk.Label -> IO ()
+setFixedLabelWidth width label = do
+  Gtk.labelSetWidthChars label width
+  Gtk.labelSetMaxWidthChars label width
+  Gtk.labelSetEllipsize label Pango.EllipsizeModeEnd
+
+stackInPill :: Text -> [TaffyIO Gtk.Widget] -> TaffyIO Gtk.Widget
+stackInPill klass builders =
+  decorateWithClassAndBoxM klass $ do
+    widgets <- sequence builders
+    liftIO $ do
+      box <- Gtk.boxNew Gtk.OrientationVertical 0
+      mapM_ (\w -> Gtk.boxPackStart box w False False 0) widgets
+      Gtk.widgetShowAll box
+      Gtk.toWidget box
+
+usageLogoWidget :: FilePath -> Text -> IO Gtk.Widget
+usageLogoWidget iconFile tooltip = do
+  iconPath <- getUserConfigFile "taffybar" ("icons/" <> iconFile)
+  iconWidget <-
+    pixbufNewFromFileAtScaleByHeight 18 iconPath >>= \case
+      Right pixbuf -> Gtk.toWidget =<< Gtk.imageNewFromPixbuf (Just pixbuf)
+      Left _ -> Gtk.toWidget =<< Gtk.labelNew (Just "?")
+  Gtk.widgetSetTooltipText iconWidget (Just tooltip)
+  widgetSetClassGI iconWidget "usage-logo"