From a59c316d85159cebb143cd8ea97de64a0eb2fec5 Mon Sep 17 00:00:00 2001 From: Ivan Malison Date: Tue, 5 May 2026 03:04:15 -0700 Subject: [PATCH] refactor: split taffybar config into modules --- .../config/taffybar/TaffybarConfig/Config.hs | 35 + .../config/taffybar/TaffybarConfig/Host.hs | 41 + .../taffybar/TaffybarConfig/WidgetUtil.hs | 80 ++ .../config/taffybar/TaffybarConfig/Widgets.hs | 480 ++++++++++++ .../taffybar/TaffybarConfig/Workspaces.hs | 163 ++++ .../config/taffybar/imalison-taffybar.cabal | 5 + dotfiles/config/taffybar/taffybar.hs | 736 +----------------- 7 files changed, 808 insertions(+), 732 deletions(-) create mode 100644 dotfiles/config/taffybar/TaffybarConfig/Config.hs create mode 100644 dotfiles/config/taffybar/TaffybarConfig/Host.hs create mode 100644 dotfiles/config/taffybar/TaffybarConfig/WidgetUtil.hs create mode 100644 dotfiles/config/taffybar/TaffybarConfig/Widgets.hs create mode 100644 dotfiles/config/taffybar/TaffybarConfig/Workspaces.hs diff --git a/dotfiles/config/taffybar/TaffybarConfig/Config.hs b/dotfiles/config/taffybar/TaffybarConfig/Config.hs new file mode 100644 index 00000000..d5fba7e6 --- /dev/null +++ b/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 + } diff --git a/dotfiles/config/taffybar/TaffybarConfig/Host.hs b/dotfiles/config/taffybar/TaffybarConfig/Host.hs new file mode 100644 index 00000000..a95c3d6d --- /dev/null +++ b/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 diff --git a/dotfiles/config/taffybar/TaffybarConfig/WidgetUtil.hs b/dotfiles/config/taffybar/TaffybarConfig/WidgetUtil.hs new file mode 100644 index 00000000..c7c880ab --- /dev/null +++ b/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" diff --git a/dotfiles/config/taffybar/TaffybarConfig/Widgets.hs b/dotfiles/config/taffybar/TaffybarConfig/Widgets.hs new file mode 100644 index 00000000..3a1a82d8 --- /dev/null +++ b/dotfiles/config/taffybar/TaffybarConfig/Widgets.hs @@ -0,0 +1,480 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module TaffybarConfig.Widgets + ( clockWidget, + endWidgetsForHost, + startWidgetsForBackend, + ) +where + +import Control.Concurrent (threadDelay) +import Control.Monad.IO.Class (liftIO) +import Data.Char (toLower) +import Data.Maybe (fromMaybe) +import Data.Ratio ((%)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified GI.Gtk as Gtk +import qualified StatusNotifier.Tray as SNITray +import TaffybarConfig.Host (laptopHosts) +import TaffybarConfig.WidgetUtil + ( decorateWithClassAndBox, + decorateWithClassAndBoxM, + setFixedLabelWidth, + setLabelAlignmentRecursively, + stackInPill, + usageLogoWidget, + ) +import TaffybarConfig.Workspaces (workspaceLabelSetter, workspaceWindowIconGetter) +import System.Environment (lookupEnv) +import System.Environment.XDG.BaseDir (getUserConfigFile) +import System.Taffybar.Context + ( Backend (BackendWayland, BackendX11), + TaffyIO, + ) +import System.Taffybar.Information.Memory (MemoryInfo (..), parseMeminfo) +import qualified System.Taffybar.Information.Workspaces.Model as WorkspaceModel +import System.Taffybar.Util (postGUIASync) +import System.Taffybar.Widget +import qualified System.Taffybar.Widget.ASUS as ASUS +import System.Taffybar.Widget.AnthropicUsage + ( AnthropicUsageDisplayMode (AnthropicUsageDisplayRemaining), + AnthropicUsageStackConfig (..), + anthropicUsageSectionNewWith, + defaultAnthropicUsageStackConfig, + ) +import System.Taffybar.Widget.CPUMonitor (cpuMonitorNew) +import System.Taffybar.Widget.Generic.Graph (GraphConfig (..), GraphDirection (..), GraphStyle (..), defaultGraphConfig) +import qualified System.Taffybar.Widget.NetworkManager as NetworkManager +import System.Taffybar.Widget.OpenAIUsage + ( OpenAIUsageDisplayMode (OpenAIUsageDisplayRemaining), + OpenAIUsageStackConfig (..), + defaultOpenAIUsageStackConfig, + openAIUsageSectionNewWith, + ) +import qualified System.Taffybar.Widget.PulseAudio as PulseAudio +import System.Taffybar.Widget.SNIMenu (withNmAppletMenu) +import System.Taffybar.Widget.SNITray + ( CollapsibleSNITrayParams (..), + SNITrayConfig (..), + defaultCollapsibleSNITrayParams, + defaultSNITrayConfig, + ) +import System.Taffybar.Widget.SNITray.PrioritizedCollapsible + ( PrioritizedCollapsibleSNITrayParams (..), + defaultPrioritizedCollapsibleSNITrayParams, + sniTrayPrioritizedCollapsibleNewFromParams, + ) +import qualified System.Taffybar.Widget.ScreenLock as ScreenLock +import System.Taffybar.Widget.Util + ( backgroundLoop, + buildIconLabelBox, + pixbufNewFromFileAtScaleByHeight, + widgetSetClassGI, + ) +import qualified System.Taffybar.Widget.Wlsunset as Wlsunset +import qualified System.Taffybar.Widget.Workspaces as Workspaces +import Text.Printf (printf) +import Text.Read (readMaybe) + +audioWidget :: TaffyIO Gtk.Widget +audioWidget = + decorateWithClassAndBoxM "audio" PulseAudio.pulseAudioNew + +networkInnerWidget :: TaffyIO Gtk.Widget +networkInnerWidget = + withNmAppletMenu NetworkManager.networkManagerWifiIconLabelNew + >>= flip widgetSetClassGI "network" + +networkWidget :: TaffyIO Gtk.Widget +networkWidget = + decorateWithClassAndBoxM "network" networkInnerWidget + +layoutWidget :: TaffyIO Gtk.Widget +layoutWidget = + decorateWithClassAndBoxM "layout" (layoutNew defaultLayoutConfig) + +windowsWidget :: TaffyIO Gtk.Widget +windowsWidget = + decorateWithClassAndBoxM + "windows" + ( windowsNew + defaultWindowsConfig + { getActiveLabel = truncatedGetActiveLabel 28, + configureActiveLabel = liftIO . setFixedLabelWidth 28 + } + ) + +workspacesWidget :: TaffyIO Gtk.Widget +workspacesWidget = + Workspaces.workspacesNew cfg + where + cfg = + Workspaces.defaultWorkspacesConfig + { Workspaces.widgetGap = 0, + Workspaces.minIcons = 1, + Workspaces.getWindowIconPixbuf = workspaceWindowIconGetter, + Workspaces.labelSetter = workspaceLabelSetter, + Workspaces.showWorkspaceFn = + \workspace -> + Workspaces.hideEmpty workspace + && not (WorkspaceModel.workspaceIsSpecial workspace) + } + +clockWidget :: TaffyIO Gtk.Widget +clockWidget = do + clock <- + textClockNewWith + defaultClockConfig + { clockUpdateStrategy = RoundedTargetInterval 60 0.0, + clockFormatString = "%a %b %_d\n%I:%M %p" + } + liftIO $ setLabelAlignmentRecursively 0.5 Gtk.JustificationCenter clock + decorateWithClassAndBox "clock" clock + +singleLineMprisLabel :: Text -> Text +singleLineMprisLabel = + T.replace "\n" " " . T.replace "\r" " " + +stackedMprisLabel :: Text -> Text +stackedMprisLabel raw = + let normalized = singleLineMprisLabel raw + (top, rest) = T.breakOn " - " normalized + in if T.null rest + then normalized + else top <> "\n" <> T.drop 3 rest + +mprisWidget :: TaffyIO Gtk.Widget +mprisWidget = + mpris2NewWithConfig + MPRIS2Config + { mprisWidgetWrapper = decorateWithClassAndBox "mpris", + updatePlayerWidget = + simplePlayerWidget + defaultPlayerConfig + { setNowPlayingLabel = + fmap stackedMprisLabel . playingText 20 20, + setupPlayerLabel = setFixedLabelWidth 20 + } + } + +batteryInnerWidget :: TaffyIO Gtk.Widget +batteryInnerWidget = do + iconWidget <- batteryTextIconNew + labelWidget <- textBatteryNew "$percentage$%" + liftIO (buildIconLabelBox iconWidget labelWidget) >>= flip widgetSetClassGI "battery" + +batteryWidget :: TaffyIO Gtk.Widget +batteryWidget = + decorateWithClassAndBoxM "battery" batteryInnerWidget + +backlightWidget :: TaffyIO Gtk.Widget +backlightWidget = + decorateWithClassAndBoxM + "backlight" + ( backlightLabelNewChanWith + defaultBacklightWidgetConfig + { backlightFormat = "☀ $percent$%", + backlightUnknownFormat = "☀ n/a", + backlightTooltipFormat = + Just "Device: $device$\nBrightness: $brightness$/$max$ ($percent$%)" + } + ) + +diskUsageInnerWidget :: TaffyIO Gtk.Widget +diskUsageInnerWidget = + diskUsageNew >>= flip widgetSetClassGI "disk-usage" + +diskUsageWidget :: TaffyIO Gtk.Widget +diskUsageWidget = + decorateWithClassAndBoxM "disk-usage" diskUsageInnerWidget + +meminfoPercentRowWidget :: + Text -> + Text -> + (MemoryInfo -> Maybe Double) -> + (MemoryInfo -> T.Text) -> + TaffyIO Gtk.Widget +meminfoPercentRowWidget rowClass iconText getRatio tooltipText = + liftIO $ do + iconW <- Gtk.toWidget =<< Gtk.labelNew (Just iconText) + valueLabel <- Gtk.labelNew (Just "") + valueW <- Gtk.toWidget valueLabel + row <- buildIconLabelBox iconW valueW + _ <- widgetSetClassGI row rowClass + + let fmtPercent :: Double -> T.Text + fmtPercent r = T.pack (printf "%.0f%%" (max 0 r * 100)) + updateOnce :: IO () + updateOnce = do + info <- parseMeminfo + let valueText = maybe "n/a" fmtPercent (getRatio info) + postGUIASync $ do + Gtk.labelSetText valueLabel valueText + Gtk.widgetSetTooltipText row (Just (tooltipText info)) + threadDelay (2 * 1000000) + + _ <- Gtk.onWidgetRealize row $ backgroundLoop updateOnce + pure row + +ramRowWidget :: TaffyIO Gtk.Widget +ramRowWidget = + meminfoPercentRowWidget + "ram-row" + "\xF538" -- Font Awesome: memory + (Just . memoryUsedRatio) + (\info -> "RAM " <> showMemoryInfo "$used$/$total$" 2 info) + +swapRowWidget :: TaffyIO Gtk.Widget +swapRowWidget = + meminfoPercentRowWidget + "swap-row" + "\xF0EC" -- Font Awesome: exchange (swap-ish) + (\info -> if memorySwapTotal info <= 0 then Nothing else Just (memorySwapUsedRatio info)) + (\info -> "SWAP " <> showMemoryInfo "$swapUsed$/$swapTotal$" 2 info) + +ramSwapWidget :: TaffyIO Gtk.Widget +ramSwapWidget = + stackInPill "ram-swap" [ramRowWidget, swapRowWidget] + +audioBacklightWidget :: TaffyIO Gtk.Widget +audioBacklightWidget = + stackInPill + "audio-backlight" + [ PulseAudio.pulseAudioNew, + backlightNewChanWith + defaultBacklightWidgetConfig + { backlightFormat = "$percent$%", + backlightUnknownFormat = "n/a", + backlightTooltipFormat = + Just "Device: $device$\nBrightness: $brightness$/$max$ ($percent$%)" + } + ] + +asusInnerWidget :: TaffyIO Gtk.Widget +asusInnerWidget = ASUS.asusWidgetNew + +asusWidget :: TaffyIO Gtk.Widget +asusWidget = + decorateWithClassAndBoxM "asus-profile" asusInnerWidget + +batteryNetworkWidget :: TaffyIO Gtk.Widget +batteryNetworkWidget = + stackInPill "battery-network" [batteryInnerWidget, networkInnerWidget] + +asusDiskUsageWidget :: TaffyIO Gtk.Widget +asusDiskUsageWidget = + stackInPill "asus-disk-usage" [diskUsageInnerWidget, asusInnerWidget] + +screenLockWidget :: TaffyIO Gtk.Widget +screenLockWidget = + decorateWithClassAndBoxM "screen-lock" $ + ScreenLock.screenLockNewWithConfig + ScreenLock.defaultScreenLockConfig + { ScreenLock.screenLockIcon = T.pack "\xF023" <> " Lock" + } + +wlsunsetWidget :: TaffyIO Gtk.Widget +wlsunsetWidget = + decorateWithClassAndBoxM "wlsunset" $ + Wlsunset.wlsunsetNewWithConfig + Wlsunset.defaultWlsunsetWidgetConfig + { Wlsunset.wlsunsetWidgetIcon = T.pack "\xF0599" <> " Sun" + } + +simplifiedScreenLockWidget :: TaffyIO Gtk.Widget +simplifiedScreenLockWidget = + -- Inner widget: no extra pill wrapping (the combiner provides that). + ScreenLock.screenLockNewWithConfig + ScreenLock.defaultScreenLockConfig + { ScreenLock.screenLockIcon = T.pack "\xF023" <> " Lock" + } + +simplifiedWlsunsetWidget :: TaffyIO Gtk.Widget +simplifiedWlsunsetWidget = + -- Inner widget: no extra pill wrapping (the combiner provides that). + Wlsunset.wlsunsetNewWithConfig + Wlsunset.defaultWlsunsetWidgetConfig + { Wlsunset.wlsunsetWidgetIcon = T.pack "\xF0599" <> " Sun" + } + +sunLockWidget :: TaffyIO Gtk.Widget +sunLockWidget = + stackInPill "sun-lock" [simplifiedWlsunsetWidget, simplifiedScreenLockWidget] + +cpuWidget :: TaffyIO Gtk.Widget +cpuWidget = + decorateWithClassAndBoxM "cpu" $ + cpuMonitorNew + defaultGraphConfig + { graphDataColors = [(0, 1, 0.5, 0.8), (1, 0, 0, 0.5)], + graphBackgroundColor = (0, 0, 0, 0), + graphBorderWidth = 0, + graphLabel = Just "CPU", + graphWidth = 50, + graphDirection = LEFT_TO_RIGHT + } + 1.0 + "cpu" + +wakeupDebugWidget :: TaffyIO Gtk.Widget +wakeupDebugWidget = + decorateWithClassAndBoxM "wakeup-debug" wakeupDebugWidgetNew + +omniMenuItem :: Text -> Text -> Text -> OmniMenuItem +omniMenuItem label iconName command = + OmniMenuItem + { omniMenuItemLabel = label, + omniMenuItemCommand = command, + omniMenuItemIcon = Just iconName, + omniMenuItemTooltip = Just command + } + +omniMenuWidget :: TaffyIO Gtk.Widget +omniMenuWidget = + decorateWithClassAndBoxM "omni-menu" $ do + icon <- + liftIO $ do + iconPath <- getUserConfigFile "taffybar" "icons/nix-snowflake.svg" + pixbufNewFromFileAtScaleByHeight 18 iconPath >>= \case + Right pixbuf -> Gtk.toWidget =<< Gtk.imageNewFromPixbuf (Just pixbuf) + Left _ -> + Gtk.imageNewFromIconName + (Just "system-run") + (fromIntegral $ fromEnum Gtk.IconSizeMenu) + >>= Gtk.toWidget + omniMenuNewWithConfig + (defaultOmniMenuConfig icon) + { omniMenuIncludeApplications = True, + omniMenuSections = + [ OmniMenuSection + "Launch" + [ omniMenuItem "App launcher" "view-app-grid-symbolic" "hypr_shell_ui launcher", + omniMenuItem "Run command" "system-run" "hypr_shell_ui run", + omniMenuItem "Terminal" "utilities-terminal" "ghostty --gtk-single-instance=false", + omniMenuItem "Window picker" "preferences-system-windows" "hypr_shell_ui window go" + ], + OmniMenuSection + "System" + [ omniMenuItem "Lock" "system-lock-screen" "loginctl lock-session", + omniMenuItem "Toggle screensaver" "video-display" "/home/imalison/dotfiles/dotfiles/lib/bin/hypr-screensaver toggle", + omniMenuItem "Reload WM" "view-refresh" "sh -lc 'hyprctl reload || xmonad --restart || river-xmonad-restart'", + omniMenuItem "Restart taffybar" "view-refresh-symbolic" "/home/imalison/dotfiles/dotfiles/config/taffybar/scripts/taffybar-restart", + omniMenuItem "Logout" "system-log-out" "sh -lc 'hyprctl dispatch exit || riverctl exit'", + omniMenuItem "Suspend" "media-playback-pause" "systemctl suspend", + omniMenuItem "Reboot" "system-reboot" "systemctl reboot", + omniMenuItem "Power off" "system-shutdown" "systemctl poweroff" + ] + ] + } + +usageSectionWidget :: Text -> FilePath -> Text -> TaffyIO Gtk.Widget -> TaffyIO Gtk.Widget +usageSectionWidget klass iconFile tooltip stackBuilder = + decorateWithClassAndBoxM klass $ do + stack <- stackBuilder + liftIO $ do + iconWidget <- usageLogoWidget iconFile tooltip + section <- buildIconLabelBox iconWidget stack + widgetSetClassGI section "usage-section" + +openAIUsageWidget :: TaffyIO Gtk.Widget +openAIUsageWidget = do + iconWidget <- liftIO $ usageLogoWidget "openai-symbol.svg" "OpenAI usage" + decorateWithClassAndBoxM "openai-usage" $ + openAIUsageSectionNewWith + iconWidget + defaultOpenAIUsageStackConfig + { openAIUsageStackDefaultDisplayMode = OpenAIUsageDisplayRemaining + } + +anthropicUsageWidget :: TaffyIO Gtk.Widget +anthropicUsageWidget = do + iconWidget <- liftIO $ usageLogoWidget "claude-symbol.svg" "Anthropic usage" + decorateWithClassAndBoxM "anthropic-usage" $ + anthropicUsageSectionNewWith + iconWidget + defaultAnthropicUsageStackConfig + { anthropicUsageStackDefaultDisplayMode = AnthropicUsageDisplayRemaining + } + +sniPriorityVisibilityThresholdDefault :: Int +sniPriorityVisibilityThresholdDefault = 0 + +sniTrayWidget :: TaffyIO Gtk.Widget +sniTrayWidget = do + -- If the Haskell backend regresses, flip at runtime: + -- TAFFYBAR_SNI_MENU_BACKEND=lib + backendEnv <- liftIO (lookupEnv "TAFFYBAR_SNI_MENU_BACKEND") + thresholdEnv <- liftIO (lookupEnv "TAFFYBAR_SNI_PRIORITY_THRESHOLD") + let menuBackend = + case fmap (map toLower) backendEnv of + Just "lib" -> SNITray.LibDBusMenu + _ -> SNITray.HaskellDBusMenu + visibilityThreshold = + fromMaybe + sniPriorityVisibilityThresholdDefault + (thresholdEnv >>= readMaybe) + trayParams = + SNITray.defaultTrayParams + { SNITray.trayMenuBackend = menuBackend, + SNITray.trayOverlayScale = 1 % 3, + SNITray.trayEventHooks = SNITray.defaultTrayEventHooks + } + sniTrayConfig = + defaultSNITrayConfig + { sniTrayTrayParams = trayParams + } + collapsibleParams = + defaultCollapsibleSNITrayParams + { collapsibleSNITrayConfig = sniTrayConfig + } + prioritizedParams = + defaultPrioritizedCollapsibleSNITrayParams + { prioritizedCollapsibleSNITrayParams = collapsibleParams, + prioritizedCollapsibleSNITrayVisibilityThreshold = Just visibilityThreshold + } + decorateWithClassAndBoxM + "sni-tray" + (sniTrayPrioritizedCollapsibleNewFromParams prioritizedParams) + +startWidgetsForBackend :: Backend -> [TaffyIO Gtk.Widget] +startWidgetsForBackend backend = + case backend of + BackendX11 -> [omniMenuWidget, workspacesWidget, layoutWidget, windowsWidget] + -- These Wayland widgets are Hyprland-specific. + BackendWayland -> [omniMenuWidget, workspacesWidget, windowsWidget] + +endWidgetsForHost :: String -> [TaffyIO Gtk.Widget] +endWidgetsForHost hostName = + -- NOTE: end widgets are packed with Gtk.boxPackEnd, so the list order is + -- right-to-left on screen. Make the tray appear at the far right by placing + -- it first in the list. (On laptops: the battery/wifi stack is far right, + -- tray immediately left of it.) + let baseEndWidgets = + [ sniTrayWidget, + audioWidget, + anthropicUsageWidget, + openAIUsageWidget, + cpuWidget, + ramSwapWidget, + diskUsageWidget, + networkWidget, + sunLockWidget, + mprisWidget + ] + laptopEndWidgets = + [ batteryNetworkWidget, + sniTrayWidget, + asusDiskUsageWidget, + audioBacklightWidget, + anthropicUsageWidget, + openAIUsageWidget, + cpuWidget, + ramSwapWidget, + sunLockWidget, + mprisWidget + ] + in if hostName `elem` laptopHosts + then laptopEndWidgets + else baseEndWidgets diff --git a/dotfiles/config/taffybar/TaffybarConfig/Workspaces.hs b/dotfiles/config/taffybar/TaffybarConfig/Workspaces.hs new file mode 100644 index 00000000..b1760ddb --- /dev/null +++ b/dotfiles/config/taffybar/TaffybarConfig/Workspaces.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE OverloadedStrings #-} + +module TaffybarConfig.Workspaces + ( workspaceLabelSetter, + workspaceWindowIconGetter, + ) +where + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Reader (asks) +import Data.Int (Int32) +import Data.List (nub) +import qualified Data.Map as M +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk +import System.Taffybar.Context + ( Backend (BackendX11), + TaffyIO, + backend, + runX11Def, + ) +import System.Taffybar.Information.EWMHDesktopInfo (WorkspaceId (..)) +import qualified System.Taffybar.Information.Workspaces.Model as WorkspaceModel +import System.Taffybar.Information.X11DesktopInfo +import System.Taffybar.Util (getPixbufFromFilePath, maybeTCombine, (<|||>)) +import System.Taffybar.Widget.Util (loadPixbufByName) +import qualified System.Taffybar.Widget.Workspaces as Workspaces +import System.Taffybar.WindowIcon (pixBufFromColor) + +x11FullWorkspaceNames :: X11Property [(WorkspaceId, String)] +x11FullWorkspaceNames = + go <$> readAsListOfString Nothing "_NET_DESKTOP_FULL_NAMES" + where + go = zip [WorkspaceId i | i <- [0 ..]] + +remapNSP :: String -> String +remapNSP "NSP" = "S" +remapNSP n = n + +workspaceLabelSetter :: WorkspaceModel.WorkspaceInfo -> TaffyIO String +workspaceLabelSetter workspace = do + backendType <- asks backend + let identity = WorkspaceModel.workspaceIdentity workspace + fallbackLabel = remapNSP $ T.unpack (WorkspaceModel.workspaceName identity) + case (backendType, WorkspaceModel.workspaceNumericId identity) of + (BackendX11, Just workspaceId) -> do + fullNames <- runX11Def [] x11FullWorkspaceNames + return $ remapNSP $ fromMaybe fallbackLabel (lookup (WorkspaceId workspaceId) fullNames) + _ -> return fallbackLabel + +iconRemap :: [(Text, [Text])] +iconRemap = + [ ("spotify", ["spotify-client", "spotify"]) + ] + +iconRemapMap :: M.Map Text [Text] +iconRemapMap = + M.fromList [(T.toLower k, v) | (k, v) <- iconRemap] + +lookupIconRemap :: Text -> [Text] +lookupIconRemap name = fromMaybe [] $ M.lookup (T.toLower name) iconRemapMap + +iconNameVariants :: Text -> [Text] +iconNameVariants raw = + let lower = T.toLower raw + stripped = fromMaybe lower (T.stripSuffix ".desktop" lower) + suffixes = ["-gtk", "-client", "-desktop"] + stripSuffixes name = + let variants = mapMaybe (`T.stripSuffix` name) suffixes + in nub $ variants ++ [name] + baseNames = stripSuffixes stripped ++ [raw] + toDash c + | c == ' ' || c == '_' || c == '.' || c == '/' = '-' + | otherwise = c + toUnderscore c + | c == ' ' || c == '-' || c == '.' || c == '/' = '_' + | otherwise = c + variantsFor name = + let dotted = + case T.splitOn "." name of + [] -> name + xs -> last xs + dashed = T.map toDash name + dashedDotted = T.map toDash dotted + underscored = T.map toUnderscore name + underscoredDotted = T.map toUnderscore dotted + in [dotted, dashed, dashedDotted, underscored, underscoredDotted, name] + in nub $ concatMap variantsFor baseNames + +workspaceIconCandidates :: WorkspaceModel.WindowInfo -> [Text] +workspaceIconCandidates windowData = + let baseNames = WorkspaceModel.windowClassHints windowData + remapped = concatMap lookupIconRemap baseNames + remappedExpanded = concatMap iconNameVariants remapped + baseExpanded = concatMap iconNameVariants baseNames + in nub (remappedExpanded ++ baseExpanded) + +isPathCandidate :: Text -> Bool +isPathCandidate name = + T.isInfixOf "/" name + || any (`T.isSuffixOf` name) [".png", ".svg", ".xpm"] + +workspaceCandidateInfo :: Text -> WorkspaceModel.WindowInfo +workspaceCandidateInfo name = + WorkspaceModel.WindowInfo + { WorkspaceModel.windowIdentity = WorkspaceModel.HyprlandWindowIdentity "", + WorkspaceModel.windowTitle = "", + WorkspaceModel.windowClassHints = [name], + WorkspaceModel.windowPosition = Nothing, + WorkspaceModel.windowUrgent = False, + WorkspaceModel.windowActive = False, + WorkspaceModel.windowMinimized = False + } + +workspaceIconFromCandidate :: Int32 -> Text -> TaffyIO (Maybe Gdk.Pixbuf) +workspaceIconFromCandidate size name + | isPathCandidate name = + liftIO $ getPixbufFromFilePath (T.unpack name) + | otherwise = + maybeTCombine + (Workspaces.getWindowIconPixbufFromDesktopEntry size (workspaceCandidateInfo name)) + (liftIO $ loadPixbufByName size name) + +workspaceManualIconGetter :: Workspaces.WindowIconPixbufGetter +workspaceManualIconGetter = + Workspaces.handleIconGetterException $ \size windowData -> + foldl maybeTCombine (return Nothing) $ + map (workspaceIconFromCandidate size) (workspaceIconCandidates windowData) + +fallbackIconPixbuf :: Int32 -> TaffyIO (Maybe Gdk.Pixbuf) +fallbackIconPixbuf size = do + let fallbackNames = + [ "application-x-executable", + "application", + "image-missing", + "gtk-missing-image", + "dialog-question", + "utilities-terminal", + "system-run", + "window" + ] + tryNames = + foldl + maybeTCombine + (return Nothing) + (map (liftIO . loadPixbufByName size) fallbackNames) + result <- tryNames + case result of + Just _ -> return result + Nothing -> Just <$> pixBufFromColor size 0x5f5f5fff + +workspaceFallbackIcon :: Workspaces.WindowIconPixbufGetter +workspaceFallbackIcon size _ = + fallbackIconPixbuf size + +workspaceWindowIconGetter :: Workspaces.WindowIconPixbufGetter +workspaceWindowIconGetter = + workspaceManualIconGetter + <|||> Workspaces.getWindowIconPixbufFromChrome + <|||> Workspaces.defaultGetWindowIconPixbuf + <|||> workspaceFallbackIcon diff --git a/dotfiles/config/taffybar/imalison-taffybar.cabal b/dotfiles/config/taffybar/imalison-taffybar.cabal index 9dc465e4..cf530592 100644 --- a/dotfiles/config/taffybar/imalison-taffybar.cabal +++ b/dotfiles/config/taffybar/imalison-taffybar.cabal @@ -13,6 +13,11 @@ cabal-version: >=1.10 executable taffybar hs-source-dirs: . main-is: taffybar.hs + other-modules: TaffybarConfig.Config + , TaffybarConfig.Host + , TaffybarConfig.Widgets + , TaffybarConfig.WidgetUtil + , TaffybarConfig.Workspaces ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-prof-options: -fprof-auto build-depends: base diff --git a/dotfiles/config/taffybar/taffybar.hs b/dotfiles/config/taffybar/taffybar.hs index 6bba9122..a9a5ee3b 100644 --- a/dotfiles/config/taffybar/taffybar.hs +++ b/dotfiles/config/taffybar/taffybar.hs @@ -1,744 +1,16 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - module Main (main) where -import Control.Concurrent (threadDelay) -import Control.Monad (void, when) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.Reader (asks) -import Data.Char (toLower) -import Data.Foldable (for_) -import Data.GI.Base (castTo) -import Data.Int (Int32) -import Data.List (nub) -import qualified Data.Map as M -import Data.Maybe (fromMaybe, mapMaybe) -import Data.Ratio ((%)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk -import qualified GI.Gtk as Gtk -import qualified GI.Pango as Pango +import TaffybarConfig.Config (mkSimpleTaffyConfig) +import TaffybarConfig.Host (cssFilesForHost) import Network.HostName (getHostName) -import qualified StatusNotifier.Tray as SNITray -import System.Environment (lookupEnv) import System.Environment.XDG.BaseDir (getUserConfigFile) import System.Log.Logger (Priority (WARNING), rootLoggerName, setLevel, updateGlobalLogger) import System.Taffybar (startTaffybar) -import System.Taffybar.Context - ( Backend (BackendWayland, BackendX11), - TaffyIO, - backend, - detectBackend, - runX11Def, - ) +import System.Taffybar.Context (detectBackend) import System.Taffybar.DBus import System.Taffybar.DBus.Toggle import System.Taffybar.Hooks (withLogLevels) -import System.Taffybar.Information.EWMHDesktopInfo (WorkspaceId (..)) -import System.Taffybar.Information.Memory (MemoryInfo (..), parseMeminfo) -import qualified System.Taffybar.Information.Workspaces.Model as WorkspaceModel -import System.Taffybar.Information.X11DesktopInfo -import System.Taffybar.SimpleConfig -import System.Taffybar.Util (getPixbufFromFilePath, maybeTCombine, postGUIASync, (<|||>)) -import System.Taffybar.Widget -import qualified System.Taffybar.Widget.ASUS as ASUS -import System.Taffybar.Widget.AnthropicUsage - ( AnthropicUsageDisplayMode (AnthropicUsageDisplayRemaining), - AnthropicUsageStackConfig (..), - anthropicUsageSectionNewWith, - defaultAnthropicUsageStackConfig, - ) -import System.Taffybar.Widget.CPUMonitor (cpuMonitorNew) -import System.Taffybar.Widget.Generic.Graph (GraphConfig (..), GraphDirection (..), GraphStyle (..), defaultGraphConfig) -import qualified System.Taffybar.Widget.NetworkManager as NetworkManager -import System.Taffybar.Widget.OpenAIUsage - ( OpenAIUsageDisplayMode (OpenAIUsageDisplayRemaining), - OpenAIUsageStackConfig (..), - defaultOpenAIUsageStackConfig, - openAIUsageSectionNewWith, - ) -import qualified System.Taffybar.Widget.PulseAudio as PulseAudio -import System.Taffybar.Widget.SNIMenu (withNmAppletMenu) -import System.Taffybar.Widget.SNITray - ( CollapsibleSNITrayParams (..), - SNITrayConfig (..), - defaultCollapsibleSNITrayParams, - defaultSNITrayConfig, - ) -import System.Taffybar.Widget.SNITray.PrioritizedCollapsible - ( PrioritizedCollapsibleSNITrayParams (..), - defaultPrioritizedCollapsibleSNITrayParams, - sniTrayPrioritizedCollapsibleNewFromParams, - ) -import qualified System.Taffybar.Widget.ScreenLock as ScreenLock -import System.Taffybar.Widget.Util (backgroundLoop, buildContentsBox, buildIconLabelBox, loadPixbufByName, pixbufNewFromFileAtScaleByHeight, widgetSetClassGI) -import qualified System.Taffybar.Widget.Wlsunset as Wlsunset -import qualified System.Taffybar.Widget.Workspaces as Workspaces -import System.Taffybar.WindowIcon (pixBufFromColor) -import Text.Printf (printf) -import Text.Read (readMaybe) - --- | 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 - --- ** X11 Workspaces - -x11FullWorkspaceNames :: X11Property [(WorkspaceId, String)] -x11FullWorkspaceNames = - go <$> readAsListOfString Nothing "_NET_DESKTOP_FULL_NAMES" - where - go = zip [WorkspaceId i | i <- [0 ..]] - -remapNSP :: String -> String -remapNSP "NSP" = "S" -remapNSP n = n - -workspaceLabelSetter :: WorkspaceModel.WorkspaceInfo -> TaffyIO String -workspaceLabelSetter workspace = do - backendType <- asks backend - let identity = WorkspaceModel.workspaceIdentity workspace - fallbackLabel = remapNSP $ T.unpack (WorkspaceModel.workspaceName identity) - case (backendType, WorkspaceModel.workspaceNumericId identity) of - (BackendX11, Just workspaceId) -> do - fullNames <- runX11Def [] x11FullWorkspaceNames - return $ remapNSP $ fromMaybe fallbackLabel (lookup (WorkspaceId workspaceId) fullNames) - _ -> return fallbackLabel - --- ** Logging - --- ** Hyprland Icon Finding - -iconRemap :: [(Text, [Text])] -iconRemap = - [ ("spotify", ["spotify-client", "spotify"]) - ] - -iconRemapMap :: M.Map Text [Text] -iconRemapMap = - M.fromList [(T.toLower k, v) | (k, v) <- iconRemap] - -lookupIconRemap :: Text -> [Text] -lookupIconRemap name = fromMaybe [] $ M.lookup (T.toLower name) iconRemapMap - -iconNameVariants :: Text -> [Text] -iconNameVariants raw = - let lower = T.toLower raw - stripped = fromMaybe lower (T.stripSuffix ".desktop" lower) - suffixes = ["-gtk", "-client", "-desktop"] - stripSuffixes name = - let variants = mapMaybe (`T.stripSuffix` name) suffixes - in nub $ variants ++ [name] - baseNames = stripSuffixes stripped ++ [raw] - toDash c - | c == ' ' || c == '_' || c == '.' || c == '/' = '-' - | otherwise = c - toUnderscore c - | c == ' ' || c == '-' || c == '.' || c == '/' = '_' - | otherwise = c - variantsFor name = - let dotted = - case T.splitOn "." name of - [] -> name - xs -> last xs - dashed = T.map toDash name - dashedDotted = T.map toDash dotted - underscored = T.map toUnderscore name - underscoredDotted = T.map toUnderscore dotted - in [dotted, dashed, dashedDotted, underscored, underscoredDotted, name] - in nub $ concatMap variantsFor baseNames - -workspaceIconCandidates :: WorkspaceModel.WindowInfo -> [Text] -workspaceIconCandidates windowData = - let baseNames = WorkspaceModel.windowClassHints windowData - remapped = concatMap lookupIconRemap baseNames - remappedExpanded = concatMap iconNameVariants remapped - baseExpanded = concatMap iconNameVariants baseNames - in nub (remappedExpanded ++ baseExpanded) - -isPathCandidate :: Text -> Bool -isPathCandidate name = - T.isInfixOf "/" name - || any (`T.isSuffixOf` name) [".png", ".svg", ".xpm"] - -workspaceCandidateInfo :: Text -> WorkspaceModel.WindowInfo -workspaceCandidateInfo name = - WorkspaceModel.WindowInfo - { WorkspaceModel.windowIdentity = WorkspaceModel.HyprlandWindowIdentity "", - WorkspaceModel.windowTitle = "", - WorkspaceModel.windowClassHints = [name], - WorkspaceModel.windowPosition = Nothing, - WorkspaceModel.windowUrgent = False, - WorkspaceModel.windowActive = False, - WorkspaceModel.windowMinimized = False - } - -workspaceIconFromCandidate :: Int32 -> Text -> TaffyIO (Maybe Gdk.Pixbuf) -workspaceIconFromCandidate size name - | isPathCandidate name = - liftIO $ getPixbufFromFilePath (T.unpack name) - | otherwise = - maybeTCombine - (Workspaces.getWindowIconPixbufFromDesktopEntry size (workspaceCandidateInfo name)) - (liftIO $ loadPixbufByName size name) - -workspaceManualIconGetter :: Workspaces.WindowIconPixbufGetter -workspaceManualIconGetter = - Workspaces.handleIconGetterException $ \size windowData -> - foldl maybeTCombine (return Nothing) $ - map (workspaceIconFromCandidate size) (workspaceIconCandidates windowData) - -fallbackIconPixbuf :: Int32 -> TaffyIO (Maybe Gdk.Pixbuf) -fallbackIconPixbuf size = do - let fallbackNames = - [ "application-x-executable", - "application", - "image-missing", - "gtk-missing-image", - "dialog-question", - "utilities-terminal", - "system-run", - "window" - ] - tryNames = - foldl - maybeTCombine - (return Nothing) - (map (liftIO . loadPixbufByName size) fallbackNames) - result <- tryNames - case result of - Just _ -> return result - Nothing -> Just <$> pixBufFromColor size 0x5f5f5fff - -workspaceFallbackIcon :: Workspaces.WindowIconPixbufGetter -workspaceFallbackIcon size _ = - fallbackIconPixbuf size - -workspaceWindowIconGetter :: Workspaces.WindowIconPixbufGetter -workspaceWindowIconGetter = - workspaceManualIconGetter - <|||> Workspaces.getWindowIconPixbufFromChrome - <|||> Workspaces.defaultGetWindowIconPixbuf - <|||> workspaceFallbackIcon - --- ** Host Overrides - --- 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 - --- ** Widgets - -audioWidget :: TaffyIO Gtk.Widget -audioWidget = - decorateWithClassAndBoxM "audio" PulseAudio.pulseAudioNew - -networkInnerWidget :: TaffyIO Gtk.Widget -networkInnerWidget = - withNmAppletMenu NetworkManager.networkManagerWifiIconLabelNew - >>= flip widgetSetClassGI "network" - -networkWidget :: TaffyIO Gtk.Widget -networkWidget = - decorateWithClassAndBoxM "network" networkInnerWidget - -layoutWidget :: TaffyIO Gtk.Widget -layoutWidget = - decorateWithClassAndBoxM "layout" (layoutNew defaultLayoutConfig) - -windowsWidget :: TaffyIO Gtk.Widget -windowsWidget = - decorateWithClassAndBoxM - "windows" - ( windowsNew - defaultWindowsConfig - { getActiveLabel = truncatedGetActiveLabel 28, - configureActiveLabel = liftIO . setFixedLabelWidth 28 - } - ) - -workspacesWidget :: TaffyIO Gtk.Widget -workspacesWidget = - Workspaces.workspacesNew cfg - where - cfg = - Workspaces.defaultWorkspacesConfig - { Workspaces.widgetGap = 0, - Workspaces.minIcons = 1, - Workspaces.getWindowIconPixbuf = workspaceWindowIconGetter, - Workspaces.labelSetter = workspaceLabelSetter, - Workspaces.showWorkspaceFn = - \workspace -> - Workspaces.hideEmpty workspace - && not (WorkspaceModel.workspaceIsSpecial workspace) - } - -clockWidget :: TaffyIO Gtk.Widget -clockWidget = do - clock <- - textClockNewWith - defaultClockConfig - { clockUpdateStrategy = RoundedTargetInterval 60 0.0, - clockFormatString = "%a %b %_d\n%I:%M %p" - } - liftIO $ setLabelAlignmentRecursively 0.5 Gtk.JustificationCenter clock - decorateWithClassAndBox "clock" clock - -singleLineMprisLabel :: Text -> Text -singleLineMprisLabel = - T.replace "\n" " " . T.replace "\r" " " - -stackedMprisLabel :: Text -> Text -stackedMprisLabel raw = - let normalized = singleLineMprisLabel raw - (top, rest) = T.breakOn " - " normalized - in if T.null rest - then normalized - else top <> "\n" <> T.drop 3 rest - -mprisWidget :: TaffyIO Gtk.Widget -mprisWidget = - mpris2NewWithConfig - MPRIS2Config - { mprisWidgetWrapper = decorateWithClassAndBox "mpris", - updatePlayerWidget = - simplePlayerWidget - defaultPlayerConfig - { setNowPlayingLabel = - fmap stackedMprisLabel . playingText 20 20, - setupPlayerLabel = setFixedLabelWidth 20 - } - } - -batteryInnerWidget :: TaffyIO Gtk.Widget -batteryInnerWidget = do - iconWidget <- batteryTextIconNew - labelWidget <- textBatteryNew "$percentage$%" - liftIO (buildIconLabelBox iconWidget labelWidget) >>= flip widgetSetClassGI "battery" - -batteryWidget :: TaffyIO Gtk.Widget -batteryWidget = - decorateWithClassAndBoxM "battery" batteryInnerWidget - -backlightWidget :: TaffyIO Gtk.Widget -backlightWidget = - decorateWithClassAndBoxM - "backlight" - ( backlightLabelNewChanWith - defaultBacklightWidgetConfig - { backlightFormat = "☀ $percent$%", - backlightUnknownFormat = "☀ n/a", - backlightTooltipFormat = - Just "Device: $device$\nBrightness: $brightness$/$max$ ($percent$%)" - } - ) - -diskUsageInnerWidget :: TaffyIO Gtk.Widget -diskUsageInnerWidget = - diskUsageNew >>= flip widgetSetClassGI "disk-usage" - -diskUsageWidget :: TaffyIO Gtk.Widget -diskUsageWidget = - decorateWithClassAndBoxM "disk-usage" diskUsageInnerWidget - -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 - -meminfoPercentRowWidget :: - Text -> - Text -> - (MemoryInfo -> Maybe Double) -> - (MemoryInfo -> T.Text) -> - TaffyIO Gtk.Widget -meminfoPercentRowWidget rowClass iconText getRatio tooltipText = - liftIO $ do - iconW <- Gtk.toWidget =<< Gtk.labelNew (Just iconText) - valueLabel <- Gtk.labelNew (Just "") - valueW <- Gtk.toWidget valueLabel - row <- buildIconLabelBox iconW valueW - _ <- widgetSetClassGI row rowClass - - let fmtPercent :: Double -> T.Text - fmtPercent r = T.pack (printf "%.0f%%" (max 0 r * 100)) - updateOnce :: IO () - updateOnce = do - info <- parseMeminfo - let valueText = maybe "n/a" fmtPercent (getRatio info) - postGUIASync $ do - Gtk.labelSetText valueLabel valueText - Gtk.widgetSetTooltipText row (Just (tooltipText info)) - threadDelay (2 * 1000000) - - _ <- Gtk.onWidgetRealize row $ backgroundLoop updateOnce - pure row - -ramRowWidget :: TaffyIO Gtk.Widget -ramRowWidget = - meminfoPercentRowWidget - "ram-row" - "\xF538" -- Font Awesome: memory - (Just . memoryUsedRatio) - (\info -> "RAM " <> showMemoryInfo "$used$/$total$" 2 info) - -swapRowWidget :: TaffyIO Gtk.Widget -swapRowWidget = - meminfoPercentRowWidget - "swap-row" - "\xF0EC" -- Font Awesome: exchange (swap-ish) - (\info -> if memorySwapTotal info <= 0 then Nothing else Just (memorySwapUsedRatio info)) - (\info -> "SWAP " <> showMemoryInfo "$swapUsed$/$swapTotal$" 2 info) - -ramSwapWidget :: TaffyIO Gtk.Widget -ramSwapWidget = - stackInPill "ram-swap" [ramRowWidget, swapRowWidget] - -audioBacklightWidget :: TaffyIO Gtk.Widget -audioBacklightWidget = - stackInPill - "audio-backlight" - [ PulseAudio.pulseAudioNew, - backlightNewChanWith - defaultBacklightWidgetConfig - { backlightFormat = "$percent$%", - backlightUnknownFormat = "n/a", - backlightTooltipFormat = - Just "Device: $device$\nBrightness: $brightness$/$max$ ($percent$%)" - } - ] - -asusInnerWidget :: TaffyIO Gtk.Widget -asusInnerWidget = ASUS.asusWidgetNew - -asusWidget :: TaffyIO Gtk.Widget -asusWidget = - decorateWithClassAndBoxM "asus-profile" asusInnerWidget - -batteryNetworkWidget :: TaffyIO Gtk.Widget -batteryNetworkWidget = - stackInPill "battery-network" [batteryInnerWidget, networkInnerWidget] - -asusDiskUsageWidget :: TaffyIO Gtk.Widget -asusDiskUsageWidget = - stackInPill "asus-disk-usage" [diskUsageInnerWidget, asusInnerWidget] - -screenLockWidget :: TaffyIO Gtk.Widget -screenLockWidget = - decorateWithClassAndBoxM "screen-lock" $ - ScreenLock.screenLockNewWithConfig - ScreenLock.defaultScreenLockConfig - { ScreenLock.screenLockIcon = T.pack "\xF023" <> " Lock" - } - -wlsunsetWidget :: TaffyIO Gtk.Widget -wlsunsetWidget = - decorateWithClassAndBoxM "wlsunset" $ - Wlsunset.wlsunsetNewWithConfig - Wlsunset.defaultWlsunsetWidgetConfig - { Wlsunset.wlsunsetWidgetIcon = T.pack "\xF0599" <> " Sun" - } - -simplifiedScreenLockWidget :: TaffyIO Gtk.Widget -simplifiedScreenLockWidget = - -- Inner widget: no extra pill wrapping (the combiner provides that). - ScreenLock.screenLockNewWithConfig - ScreenLock.defaultScreenLockConfig - { ScreenLock.screenLockIcon = T.pack "\xF023" <> " Lock" - } - -simplifiedWlsunsetWidget :: TaffyIO Gtk.Widget -simplifiedWlsunsetWidget = - -- Inner widget: no extra pill wrapping (the combiner provides that). - Wlsunset.wlsunsetNewWithConfig - Wlsunset.defaultWlsunsetWidgetConfig - { Wlsunset.wlsunsetWidgetIcon = T.pack "\xF0599" <> " Sun" - } - -sunLockWidget :: TaffyIO Gtk.Widget -sunLockWidget = - stackInPill "sun-lock" [simplifiedWlsunsetWidget, simplifiedScreenLockWidget] - -cpuWidget :: TaffyIO Gtk.Widget -cpuWidget = - decorateWithClassAndBoxM "cpu" $ - cpuMonitorNew - defaultGraphConfig - { graphDataColors = [(0, 1, 0.5, 0.8), (1, 0, 0, 0.5)], - graphBackgroundColor = (0, 0, 0, 0), - graphBorderWidth = 0, - graphLabel = Just "CPU", - graphWidth = 50, - graphDirection = LEFT_TO_RIGHT - } - 1.0 - "cpu" - -wakeupDebugWidget :: TaffyIO Gtk.Widget -wakeupDebugWidget = - decorateWithClassAndBoxM "wakeup-debug" wakeupDebugWidgetNew - -omniMenuItem :: Text -> Text -> Text -> OmniMenuItem -omniMenuItem label iconName command = - OmniMenuItem - { omniMenuItemLabel = label, - omniMenuItemCommand = command, - omniMenuItemIcon = Just iconName, - omniMenuItemTooltip = Just command - } - -omniMenuWidget :: TaffyIO Gtk.Widget -omniMenuWidget = - decorateWithClassAndBoxM "omni-menu" $ do - icon <- - liftIO $ do - iconPath <- getUserConfigFile "taffybar" "icons/nix-snowflake.svg" - pixbufNewFromFileAtScaleByHeight 18 iconPath >>= \case - Right pixbuf -> Gtk.toWidget =<< Gtk.imageNewFromPixbuf (Just pixbuf) - Left _ -> - Gtk.imageNewFromIconName - (Just "system-run") - (fromIntegral $ fromEnum Gtk.IconSizeMenu) - >>= Gtk.toWidget - omniMenuNewWithConfig - (defaultOmniMenuConfig icon) - { omniMenuIncludeApplications = True, - omniMenuSections = - [ OmniMenuSection - "Launch" - [ omniMenuItem "App launcher" "view-app-grid-symbolic" "hypr_shell_ui launcher", - omniMenuItem "Run command" "system-run" "hypr_shell_ui run", - omniMenuItem "Terminal" "utilities-terminal" "ghostty --gtk-single-instance=false", - omniMenuItem "Window picker" "preferences-system-windows" "hypr_shell_ui window go" - ], - OmniMenuSection - "System" - [ omniMenuItem "Lock" "system-lock-screen" "loginctl lock-session", - omniMenuItem "Toggle screensaver" "video-display" "/home/imalison/dotfiles/dotfiles/lib/bin/hypr-screensaver toggle", - omniMenuItem "Reload WM" "view-refresh" "sh -lc 'hyprctl reload || xmonad --restart || river-xmonad-restart'", - omniMenuItem "Restart taffybar" "view-refresh-symbolic" "/home/imalison/dotfiles/dotfiles/config/taffybar/scripts/taffybar-restart", - omniMenuItem "Logout" "system-log-out" "sh -lc 'hyprctl dispatch exit || riverctl exit'", - omniMenuItem "Suspend" "media-playback-pause" "systemctl suspend", - omniMenuItem "Reboot" "system-reboot" "systemctl reboot", - omniMenuItem "Power off" "system-shutdown" "systemctl poweroff" - ] - ] - } - -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" - -usageSectionWidget :: Text -> FilePath -> Text -> TaffyIO Gtk.Widget -> TaffyIO Gtk.Widget -usageSectionWidget klass iconFile tooltip stackBuilder = - decorateWithClassAndBoxM klass $ do - stack <- stackBuilder - liftIO $ do - iconWidget <- usageLogoWidget iconFile tooltip - section <- buildIconLabelBox iconWidget stack - widgetSetClassGI section "usage-section" - -openAIUsageWidget :: TaffyIO Gtk.Widget -openAIUsageWidget = do - iconWidget <- liftIO $ usageLogoWidget "openai-symbol.svg" "OpenAI usage" - decorateWithClassAndBoxM "openai-usage" $ - openAIUsageSectionNewWith - iconWidget - defaultOpenAIUsageStackConfig - { openAIUsageStackDefaultDisplayMode = OpenAIUsageDisplayRemaining - } - -anthropicUsageWidget :: TaffyIO Gtk.Widget -anthropicUsageWidget = do - iconWidget <- liftIO $ usageLogoWidget "claude-symbol.svg" "Anthropic usage" - decorateWithClassAndBoxM "anthropic-usage" $ - anthropicUsageSectionNewWith - iconWidget - defaultAnthropicUsageStackConfig - { anthropicUsageStackDefaultDisplayMode = AnthropicUsageDisplayRemaining - } - -sniPriorityVisibilityThresholdDefault :: Int -sniPriorityVisibilityThresholdDefault = 0 - -sniTrayWidget :: TaffyIO Gtk.Widget -sniTrayWidget = do - -- If the Haskell backend regresses, flip at runtime: - -- TAFFYBAR_SNI_MENU_BACKEND=lib - backendEnv <- liftIO (lookupEnv "TAFFYBAR_SNI_MENU_BACKEND") - thresholdEnv <- liftIO (lookupEnv "TAFFYBAR_SNI_PRIORITY_THRESHOLD") - let menuBackend = - case fmap (map toLower) backendEnv of - Just "lib" -> SNITray.LibDBusMenu - _ -> SNITray.HaskellDBusMenu - visibilityThreshold = - fromMaybe - sniPriorityVisibilityThresholdDefault - (thresholdEnv >>= readMaybe) - trayParams = - SNITray.defaultTrayParams - { SNITray.trayMenuBackend = menuBackend, - SNITray.trayOverlayScale = 1 % 3, - SNITray.trayEventHooks = SNITray.defaultTrayEventHooks - } - sniTrayConfig = - defaultSNITrayConfig - { sniTrayTrayParams = trayParams - } - collapsibleParams = - defaultCollapsibleSNITrayParams - { collapsibleSNITrayConfig = sniTrayConfig - } - prioritizedParams = - defaultPrioritizedCollapsibleSNITrayParams - { prioritizedCollapsibleSNITrayParams = collapsibleParams, - prioritizedCollapsibleSNITrayVisibilityThreshold = Just visibilityThreshold - } - decorateWithClassAndBoxM - "sni-tray" - (sniTrayPrioritizedCollapsibleNewFromParams prioritizedParams) - --- ** Layout - -startWidgetsForBackend :: Backend -> [TaffyIO Gtk.Widget] -startWidgetsForBackend backend = - case backend of - BackendX11 -> [omniMenuWidget, workspacesWidget, layoutWidget, windowsWidget] - -- These Wayland widgets are Hyprland-specific. - BackendWayland -> [omniMenuWidget, workspacesWidget, windowsWidget] - -endWidgetsForHost :: String -> [TaffyIO Gtk.Widget] -endWidgetsForHost hostName = - -- NOTE: end widgets are packed with Gtk.boxPackEnd, so the list order is - -- right-to-left on screen. Make the tray appear at the far right by placing - -- it first in the list. (On laptops: the battery/wifi stack is far right, - -- tray immediately left of it.) - let baseEndWidgets = - [ sniTrayWidget, - audioWidget, - anthropicUsageWidget, - openAIUsageWidget, - cpuWidget, - ramSwapWidget, - diskUsageWidget, - networkWidget, - sunLockWidget, - mprisWidget - ] - laptopEndWidgets = - [ batteryNetworkWidget, - sniTrayWidget, - asusDiskUsageWidget, - audioBacklightWidget, - anthropicUsageWidget, - openAIUsageWidget, - cpuWidget, - ramSwapWidget, - sunLockWidget, - mprisWidget - ] - in if hostName `elem` laptopHosts - then laptopEndWidgets - else baseEndWidgets - -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 - } - --- ** Entry Point +import System.Taffybar.SimpleConfig (toTaffybarConfig) main :: IO () main = do