taffybar 6.0.0 → 7.0.0

raw patch · 35 files changed

+1496/−1053 lines, 35 filesdep +gtk-scaling-imagedep ~dbus-menudep ~gtk-sni-traydep ~gtk-strutPVP ok

version bump matches the API change (PVP)

Dependencies added: gtk-scaling-image

Dependency ranges changed: dbus-menu, gtk-sni-tray, gtk-strut, status-notifier-item, xdg-desktop-entry

API changes (from Hackage documentation)

Files

• CHANGELOG.md +45/−0
• app/AppearanceSnap.hs +3/−3
• app/AppearanceSnapHyprland.hs +5/−5
• doc/custom.md +1/−1
• doc/faq.md +33/−0
• src/System/Taffybar/Information/ASUS.hs +7/−3
• src/System/Taffybar/Information/CPU.hs +0/−18
• src/System/Taffybar/Information/CPU2.hs +20/−12
• src/System/Taffybar/Information/Layout/EWMH.hs +168/−0
• src/System/Taffybar/Information/Layout/Hyprland.hs +162/−0
• src/System/Taffybar/Information/Layout/Model.hs +34/−0
• src/System/Taffybar/Information/Memory.hs +6/−1
• src/System/Taffybar/Information/Workspaces/EWMH.hs +3/−1
• src/System/Taffybar/Information/Workspaces/Support.hs +235/−0
• src/System/Taffybar/Information/X11DesktopInfo.hs +7/−1
• src/System/Taffybar/Widget.hs +3/−0
• src/System/Taffybar/Widget/CPUMonitor.hs +7/−6
• src/System/Taffybar/Widget/CoordinatedClock.hs +175/−0
• src/System/Taffybar/Widget/Generic/AutoFillImage.hs +6/−186
• src/System/Taffybar/Widget/Generic/AutoSizeImage.hs +10/−104
• src/System/Taffybar/Widget/Generic/Graph.hs +4/−1
• src/System/Taffybar/Widget/Generic/ScalingImage.hs +1/−1
• src/System/Taffybar/Widget/HyprlandLayout.hs +27/−50
• src/System/Taffybar/Widget/Layout.hs +52/−42
• src/System/Taffybar/Widget/MPRIS2.hs +9/−8
• src/System/Taffybar/Widget/SNITray.hs +14/−8
• src/System/Taffybar/Widget/SNITray/PrioritizedCollapsible.hs +282/−246
• src/System/Taffybar/Widget/Text/CPUMonitor.hs +14/−13
• src/System/Taffybar/Widget/Util.hs +1/−1
• src/System/Taffybar/Widget/Windows.hs +12/−8
• src/System/Taffybar/Widget/Workspaces.hs +110/−194
• src/System/Taffybar/Widget/Workspaces/Shared.hs +0/−123
• taffybar.cabal +15/−10
• test/unit/System/Taffybar/AppearanceSpec.hs +7/−7
• test/unit/System/Taffybar/Information/LayoutSpec.hs +18/−0

@@ -1,5 +1,50 @@ # Unreleased +# 7.0.0++## Breaking Changes++* Remove the deprecated `System.Taffybar.Information.CPU` shim; use+  `System.Taffybar.Information.CPU2` instead.++## New Features++* Add `System.Taffybar.Widget.CoordinatedClock`, a shared wakeup-backed clock+  helper for coordinated time-based updates.+* Add label setup hooks for `MPRIS2` and `Windows` widgets so callers can+  customize label widgets after construction.+* Add `.graph-label` styling support for graph overlay labels and make overlay+  labels pass pointer events through to the underlying graph.++## Tray++* Move prioritized collapsible tray controls into the tray menu and auto-fit+  tray icons within the available space.+* Reduce prioritized/collapsible tray churn by deferring visibility until+  state is ready, preserving item identities, refreshing in place, and dropping+  stale rebuilds before swapping.+* Fix tray flicker and async menu regressions, prevent duplicate tray contexts+  during async initialization, eliminate duplicate startup icons, and avoid+  routine update churn.+* Improve `status-notifier-item` reconciliation so logical tray items are+  deduplicated across bus-name churn, including KDE/Qt multi-connection+  registrations.++## Fixes++* Switch `System.Taffybar.Information.CPU2.getCPULoadChan` to coordinated+  wakeups and run CPU widgets on the shared wakeup scheduler.+* Fix `MPRIS2` updates so widget visibility and CSS class changes happen in the+  same GTK sync.+* Watch XMonad visible-workspace updates so EWMH workspace state stays current+  after visibility changes.++## Packaging++* Build against monorepo-local companion packages and extract shared pixbuf+  scaling and auto-fill image helpers into the new `gtk-scaling-image`+  package.+ # 6.0.0  ## Breaking Changes

@@ -87,7 +87,7 @@     expectedTopStrut :: Maybe Int   } -data LayoutMode = LayoutLegacy | LayoutLevels | LayoutWindowsTitleStress+data LayoutMode = LayoutSingleRow | LayoutLevels | LayoutWindowsTitleStress   deriving (Eq, Show)  snapshotWatchdogTimeoutUsec :: Int@@ -201,7 +201,7 @@ buildBarConfig :: TaffyIO Gtk.Widget -> Unique -> LayoutMode -> BarConfig buildBarConfig workspaceWidget barUnique mode =   case mode of-    LayoutLegacy ->+    LayoutSingleRow ->       BarConfig         { strutConfig = baseStrutConfig 40,           widgetSpacing = 8,@@ -558,7 +558,7 @@   let selectedLayoutMode         | "--windows-title-stress" `elem` args = LayoutWindowsTitleStress         | "--levels" `elem` args = LayoutLevels-        | otherwise = LayoutLegacy+        | otherwise = LayoutSingleRow       (mExpectedTopStrut, argsSansTopStrutFlag) = parseTopStrutFlag args       argsSansFlags =         filter

@@ -60,7 +60,7 @@     layoutMode :: LayoutMode   } -data LayoutMode = LayoutLegacy | LayoutLevels+data LayoutMode = LayoutSingleRow | LayoutLevels   deriving (Eq, Show)  snapshotWatchdogTimeoutUsec :: Int@@ -173,7 +173,7 @@ buildBarConfig :: Unique -> LayoutMode -> BarConfig buildBarConfig barUnique mode =   case mode of-    LayoutLegacy ->+    LayoutSingleRow ->       BarConfig         { strutConfig = baseStrutConfig 40,           widgetSpacing = 8,@@ -272,7 +272,7 @@         shotHeight :: Int         shotHeight =           case mode of-            LayoutLegacy -> 40+            LayoutSingleRow -> 40             LayoutLevels -> 72     e <-       try (readProcess (proc "grim" ["-s", "1", "-l", "1", "-g", "0,0 1024x" ++ show shotHeight, shotPath])) ::@@ -303,7 +303,7 @@       rightCount = countColor img rightBox       level2Count = countColor img level2Center    in case mode of-        LayoutLegacy -> centerCount >= 200 && rightCount >= 50+        LayoutSingleRow -> centerCount >= 200 && rightCount >= 50         LayoutLevels -> centerCount >= 200 && rightCount >= 50 && level2Count >= 100  countColor :: JP.Image JP.PixelRGBA8 -> JP.PixelRGBA8 -> Int@@ -381,7 +381,7 @@   let selectedLayoutMode =         if "--levels" `elem` args           then LayoutLevels-          else LayoutLegacy+          else LayoutSingleRow       argsSansFlags =         filter           (`notElem` ["--levels"])

@@ -90,4 +90,4 @@ Taffybar also applies shared classes for common internals: - `.icon-label`, `.icon`, `.label` - `.polling-label`, `.polling-label-container`, `.polling-label-text`-- `.graph`, `.graph-canvas`+- `.graph`, `.graph-canvas`, `.graph-label`

@@ -199,6 +199,39 @@ For team use, add your cache URL/key to Nix `substituters` and `trusted-public-keys`. +## How do I add a label inside a graph widget?++Set `graphLabel` in `GraphConfig` to overlay text on top of the graph area.+The label is rendered using a `Gtk.Overlay`, so it appears inside the graph+rather than beside it, saving horizontal space.++The label supports Pango markup for styling.++```haskell+import System.Taffybar.Widget.Generic.Graph+import System.Taffybar.Widget.CPUMonitor (cpuMonitorNew)++myCpuGraph :: MonadIO m => m GI.Gtk.Widget+myCpuGraph =+  cpuMonitorNew+    defaultGraphConfig+      { graphLabel = Just "<span size='small'>CPU</span>"+      , graphWidth = 50+      }+    1.0+    "cpu"+```++The overlay label has the CSS class `.graph-label`, so you can style it+directly:++```css+.graph-label {+  font-size: 8pt;+  color: rgba(255, 255, 255, 0.7);+}+```+ ## How do I add click handling to a widget?  Wrap the widget in a `Gtk.EventBox` and handle button press events:

@@ -42,6 +42,7 @@ import DBus.Client import DBus.Internal.Types (Serial (..)) import qualified DBus.TH as DBus+import qualified Data.ByteString.Char8 as BS8 import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (catMaybes, fromMaybe, listToMaybe)@@ -86,6 +87,9 @@ asusLogF :: (MonadIO m, Show t) => Priority -> String -> t -> m () asusLogF = logPrintF asusLogPath +readAsciiFileStrict :: FilePath -> IO String+readAsciiFileStrict = fmap BS8.unpack . BS8.readFile+ -- | Convert profile enum to string. asusProfileToString :: ASUSPlatformProfile -> Text asusProfileToString Quiet = "Quiet"@@ -200,7 +204,7 @@       if not exists'         then return Nothing         else do-          result <- try $ readFile path :: IO (Either SomeException String)+          result <- try $ readAsciiFileStrict path :: IO (Either SomeException String)           case result of             Left _ -> return Nothing             Right s -> return $ fmap fromIntegral (readMaybe (strip s) :: Maybe Integer)@@ -241,7 +245,7 @@       if not exists'         then return Nothing         else do-          result <- try $ readFile path :: IO (Either SomeException String)+          result <- try $ readAsciiFileStrict path :: IO (Either SomeException String)           case result of             Left _ -> return Nothing             Right s -> return $ Just $ strip s@@ -250,7 +254,7 @@       if not exists'         then return Nothing         else do-          result <- try $ readFile path :: IO (Either SomeException String)+          result <- try $ readAsciiFileStrict path :: IO (Either SomeException String)           case result of             Left _ -> return Nothing             Right s -> case readMaybe (strip s) :: Maybe Integer of

@@ -1,18 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}---- | Read short-window CPU utilization samples from @/proc/stat@.-module System.Taffybar.Information.CPU-  {-# DEPRECATED "Legacy CPU module. Use System.Taffybar.Information.CPU2.getCPULoadChan (preferred) or sampleCPULoad/CPULoad." #-}-  (cpuLoad)-where--import System.Taffybar.Information.CPU2 (CPULoad (..), sampleCPULoad)--{-# DEPRECATED cpuLoad "Legacy API. Use System.Taffybar.Information.CPU2.getCPULoadChan (preferred) or sampleCPULoad." #-}---- | Return a triple with (user time, system time, total time), sampled from--- /proc/stat over 50ms.-cpuLoad :: IO (Double, Double, Double)-cpuLoad = do-  CPULoad {cpuUserLoad, cpuSystemLoad, cpuTotalLoad} <- sampleCPULoad 0.05 "cpu"-  return (cpuUserLoad, cpuSystemLoad, cpuTotalLoad)

@@ -20,9 +20,10 @@ -- (Now supports only physical cpu). module System.Taffybar.Information.CPU2 where -import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent (forkIO) import Control.Concurrent.STM.TChan import Control.Monad+import Control.Monad.IO.Class (liftIO) import Control.Monad.STM (atomically) import Data.IORef import Data.List@@ -30,7 +31,9 @@ import Safe import System.Directory import System.FilePath+import System.Taffybar.Context (TaffyIO) import System.Taffybar.Information.StreamInfo+import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay)  -- | Relative CPU load values, expressed as ratios in [0,1]. data CPULoad = CPULoad@@ -73,19 +76,24 @@  -- | Build a broadcast channel that is fed by a polling thread. ----- Each channel has its own polling thread; if multiple widgets should share a+-- The polling thread is paced by the coordinated wakeup scheduler so CPU+-- sampling aligns with other interval-driven widgets.+--+-- Each channel has its own sampling thread; if multiple widgets should share a -- data source, create once and reuse the returned channel.-getCPULoadChan :: String -> Double -> IO (TChan CPULoad)+getCPULoadChan :: String -> Double -> TaffyIO (TChan CPULoad) getCPULoadChan cpu interval = do-  chan <- newBroadcastTChanIO-  initial <- getCPUInfo cpu-  sample <- newIORef initial-  let delayMicroseconds = max 1 (floor $ interval * 1000000)-  _ <- forkIO $ forever $ do-    load <- toCPULoad <$> getAccLoad sample (getCPUInfo cpu)-    atomically $ writeTChan chan load-    threadDelay delayMicroseconds-  return chan+  wakeupChan <- getWakeupChannelForDelay (max 0.000001 interval)+  ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan+  liftIO $ do+    chan <- newBroadcastTChanIO+    initial <- getCPUInfo cpu+    sample <- newIORef initial+    _ <- forkIO $ forever $ do+      load <- toCPULoad <$> getAccLoad sample (getCPUInfo cpu)+      atomically $ writeTChan chan load+      void $ atomically $ readTChan ourWakeupChan+    return chan  toCPULoad :: [Double] -> CPULoad toCPULoad load =

@@ -0,0 +1,168 @@+{-# LANGUAGE OverloadedStrings #-}++-----------------------------------------------------------------------------++-----------------------------------------------------------------------------++-- |+-- Module      : System.Taffybar.Information.Layout.EWMH+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan A. Malison+-- Stability   : unstable+-- Portability : unportable+--+-- Shared XMonad layout provider using an X11 property subscription and a+-- broadcast channel + state MVar.+module System.Taffybar.Information.Layout.EWMH+  ( EWMHLayoutProviderConfig (..),+    defaultEWMHLayoutProviderConfig,+    defaultEWMHLayoutState,+    getEWMHLayoutStateChanAndVar,+    getEWMHLayoutStateChanAndVarWith,+    getEWMHLayoutState,+    getEWMHLayoutStateWith,+    switchEWMHLayoutBy,+    xLayoutProp,+  )+where++import Control.Concurrent.MVar+import Control.Concurrent.STM.TChan+import Control.Exception.Enclosed (catchAny)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.STM (atomically)+import Control.Monad.Trans.Reader (ask, runReaderT)+import qualified Data.Text as T+import System.Log.Logger (Priority (..), logM)+import System.Taffybar.Context+  ( TaffyIO,+    getStateDefault,+    runX11Def,+    subscribeToPropertyEvents,+    taffyFork,+  )+import System.Taffybar.Information.Layout.Model+import System.Taffybar.Information.X11DesktopInfo+  ( X11Property,+    getAtom,+    readAsString,+    sendCommandEvent,+  )++data EWMHLayoutProviderConfig = EWMHLayoutProviderConfig+  { layoutSnapshotGetter :: TaffyIO T.Text,+    layoutUpdateEvents :: [String]+  }++defaultEWMHLayoutProviderConfig :: EWMHLayoutProviderConfig+defaultEWMHLayoutProviderConfig =+  EWMHLayoutProviderConfig+    { layoutSnapshotGetter = buildEWMHLayoutSnapshot,+      layoutUpdateEvents = [xLayoutProp]+    }++defaultEWMHLayoutState :: LayoutSnapshot+defaultEWMHLayoutState =+  LayoutSnapshot+    { layoutBackend = LayoutBackendXMonad,+      layoutRevision = 0,+      layoutName = ""+    }++newtype EWMHLayoutStateChanVar+  = EWMHLayoutStateChanVar+      (TChan LayoutSnapshot, MVar LayoutSnapshot)++wLog :: (MonadIO m) => Priority -> String -> m ()+wLog level message =+  liftIO $ logM "System.Taffybar.Information.Layout.EWMH" level message++getEWMHLayoutStateChanAndVar ::+  TaffyIO (TChan LayoutSnapshot, MVar LayoutSnapshot)+getEWMHLayoutStateChanAndVar =+  getEWMHLayoutStateChanAndVarWith defaultEWMHLayoutProviderConfig++getEWMHLayoutStateChanAndVarWith ::+  EWMHLayoutProviderConfig ->+  TaffyIO (TChan LayoutSnapshot, MVar LayoutSnapshot)+getEWMHLayoutStateChanAndVarWith cfg = do+  EWMHLayoutStateChanVar chanAndVar <- getStateDefault $ buildEWMHLayoutStateChanVar cfg+  pure chanAndVar++getEWMHLayoutState :: TaffyIO LayoutSnapshot+getEWMHLayoutState =+  getEWMHLayoutStateWith defaultEWMHLayoutProviderConfig++getEWMHLayoutStateWith :: EWMHLayoutProviderConfig -> TaffyIO LayoutSnapshot+getEWMHLayoutStateWith cfg = do+  (_, stateVar) <- getEWMHLayoutStateChanAndVarWith cfg+  liftIO $ readMVar stateVar++buildEWMHLayoutStateChanVar ::+  EWMHLayoutProviderConfig ->+  TaffyIO EWMHLayoutStateChanVar+buildEWMHLayoutStateChanVar cfg = do+  stateChan <- liftIO newBroadcastTChanIO+  stateVar <- liftIO $ newMVar defaultEWMHLayoutState+  taffyFork $ ewmhLayoutStateLoop cfg stateChan stateVar+  pure $ EWMHLayoutStateChanVar (stateChan, stateVar)++ewmhLayoutStateLoop ::+  EWMHLayoutProviderConfig ->+  TChan LayoutSnapshot ->+  MVar LayoutSnapshot ->+  TaffyIO ()+ewmhLayoutStateLoop cfg stateChan stateVar = do+  refreshEWMHLayoutState cfg stateChan stateVar+  setupEWMHLayoutSubscription cfg stateChan stateVar+    `catchAny` \err ->+      wLog WARNING $ "Failed to subscribe to XMonad layout events: " <> show err++setupEWMHLayoutSubscription ::+  EWMHLayoutProviderConfig ->+  TChan LayoutSnapshot ->+  MVar LayoutSnapshot ->+  TaffyIO ()+setupEWMHLayoutSubscription cfg stateChan stateVar = do+  ctx <- ask+  let refreshForEvent _ =+        runReaderT (refreshEWMHLayoutState cfg stateChan stateVar) ctx+  _ <- subscribeToPropertyEvents (layoutUpdateEvents cfg) (liftIO . void . refreshForEvent)+  pure ()++refreshEWMHLayoutState ::+  EWMHLayoutProviderConfig ->+  TChan LayoutSnapshot ->+  MVar LayoutSnapshot ->+  TaffyIO ()+refreshEWMHLayoutState cfg stateChan stateVar = do+  previous <- liftIO $ readMVar stateVar+  name <-+    layoutSnapshotGetter cfg+      `catchAny` \err -> do+        wLog WARNING $ "XMonad layout snapshot update failed: " <> show err+        pure $ layoutName previous+  let next =+        LayoutSnapshot+          { layoutBackend = LayoutBackendXMonad,+            layoutRevision = layoutRevision previous + 1,+            layoutName = name+          }+  liftIO $ do+    _ <- swapMVar stateVar next+    atomically $ writeTChan stateChan next++buildEWMHLayoutSnapshot :: TaffyIO T.Text+buildEWMHLayoutSnapshot =+  T.pack <$> runX11Def "" (readAsString Nothing xLayoutProp)++xLayoutProp :: String+xLayoutProp = "_XMONAD_CURRENT_LAYOUT"++switchEWMHLayoutBy :: Int -> X11Property ()+switchEWMHLayoutBy amount = do+  cmd <- getAtom xLayoutProp+  sendCommandEvent cmd (fromIntegral amount)

@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings #-}++-----------------------------------------------------------------------------++-----------------------------------------------------------------------------++-- |+-- Module      : System.Taffybar.Information.Layout.Hyprland+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan A. Malison+-- Stability   : unstable+-- Portability : unportable+--+-- Shared Hyprland layout provider using the Hyprland event socket and a+-- broadcast channel + state MVar.+module System.Taffybar.Information.Layout.Hyprland+  ( HyprlandLayoutProviderConfig (..),+    defaultHyprlandLayoutProviderConfig,+    defaultHyprlandLayoutState,+    isRelevantHyprlandLayoutEvent,+    getHyprlandLayoutStateChanAndVar,+    getHyprlandLayoutStateChanAndVarWith,+    getHyprlandLayoutState,+    getHyprlandLayoutStateWith,+  )+where++import Control.Concurrent.MVar+import Control.Concurrent.STM.TChan+import Control.Exception.Enclosed (catchAny)+import Control.Monad (forever, when)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.STM (atomically)+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import System.Log.Logger (Priority (..), logM)+import System.Taffybar.Context (TaffyIO, getStateDefault, taffyFork)+import System.Taffybar.Hyprland (getHyprlandEventChan)+import qualified System.Taffybar.Information.Hyprland as Hypr+import qualified System.Taffybar.Information.Hyprland.API as HyprAPI+import qualified System.Taffybar.Information.Hyprland.Types as HyprTypes+import System.Taffybar.Information.Layout.Model+import System.Taffybar.Hyprland (getHyprlandClient)++data HyprlandLayoutProviderConfig = HyprlandLayoutProviderConfig+  { layoutSnapshotGetter :: TaffyIO T.Text,+    layoutEventFilter :: T.Text -> Bool+  }++defaultHyprlandLayoutProviderConfig :: HyprlandLayoutProviderConfig+defaultHyprlandLayoutProviderConfig =+  HyprlandLayoutProviderConfig+    { layoutSnapshotGetter = buildHyprlandLayoutSnapshot,+      layoutEventFilter = isRelevantHyprlandLayoutEvent+    }++defaultHyprlandLayoutState :: LayoutSnapshot+defaultHyprlandLayoutState =+  LayoutSnapshot+    { layoutBackend = LayoutBackendHyprland,+      layoutRevision = 0,+      layoutName = ""+    }++newtype HyprlandLayoutStateChanVar+  = HyprlandLayoutStateChanVar+      (TChan LayoutSnapshot, MVar LayoutSnapshot)++wLog :: (MonadIO m) => Priority -> String -> m ()+wLog level message =+  liftIO $ logM "System.Taffybar.Information.Layout.Hyprland" level message++isRelevantHyprlandLayoutEvent :: T.Text -> Bool+isRelevantHyprlandLayoutEvent line =+  let eventName = T.takeWhile (/= '>') line+   in eventName+        `elem` [ "workspace",+                 "workspacev2",+                 "focusedmon",+                 "monitoradded",+                 "monitorremoved",+                 "configreloaded",+                 "taffybar-hyprland-connected"+               ]++getHyprlandLayoutStateChanAndVar ::+  TaffyIO (TChan LayoutSnapshot, MVar LayoutSnapshot)+getHyprlandLayoutStateChanAndVar =+  getHyprlandLayoutStateChanAndVarWith defaultHyprlandLayoutProviderConfig++getHyprlandLayoutStateChanAndVarWith ::+  HyprlandLayoutProviderConfig ->+  TaffyIO (TChan LayoutSnapshot, MVar LayoutSnapshot)+getHyprlandLayoutStateChanAndVarWith cfg = do+  HyprlandLayoutStateChanVar chanAndVar <- getStateDefault $ buildHyprlandLayoutStateChanVar cfg+  pure chanAndVar++getHyprlandLayoutState :: TaffyIO LayoutSnapshot+getHyprlandLayoutState =+  getHyprlandLayoutStateWith defaultHyprlandLayoutProviderConfig++getHyprlandLayoutStateWith :: HyprlandLayoutProviderConfig -> TaffyIO LayoutSnapshot+getHyprlandLayoutStateWith cfg = do+  (_, stateVar) <- getHyprlandLayoutStateChanAndVarWith cfg+  liftIO $ readMVar stateVar++buildHyprlandLayoutStateChanVar ::+  HyprlandLayoutProviderConfig ->+  TaffyIO HyprlandLayoutStateChanVar+buildHyprlandLayoutStateChanVar cfg = do+  stateChan <- liftIO newBroadcastTChanIO+  stateVar <- liftIO $ newMVar defaultHyprlandLayoutState+  taffyFork $ hyprlandLayoutStateLoop cfg stateChan stateVar+  pure $ HyprlandLayoutStateChanVar (stateChan, stateVar)++hyprlandLayoutStateLoop ::+  HyprlandLayoutProviderConfig ->+  TChan LayoutSnapshot ->+  MVar LayoutSnapshot ->+  TaffyIO ()+hyprlandLayoutStateLoop cfg stateChan stateVar = do+  refreshHyprlandLayoutState cfg stateChan stateVar+  hyprlandEventChan <- getHyprlandEventChan+  events <- liftIO $ Hypr.subscribeHyprlandEvents hyprlandEventChan+  forever $ do+    line <- liftIO $ atomically $ readTChan events+    when (layoutEventFilter cfg line) $+      refreshHyprlandLayoutState cfg stateChan stateVar++refreshHyprlandLayoutState ::+  HyprlandLayoutProviderConfig ->+  TChan LayoutSnapshot ->+  MVar LayoutSnapshot ->+  TaffyIO ()+refreshHyprlandLayoutState cfg stateChan stateVar = do+  previous <- liftIO $ readMVar stateVar+  name <-+    layoutSnapshotGetter cfg+      `catchAny` \err -> do+        wLog WARNING $ "Hyprland layout snapshot update failed: " <> show err+        pure $ layoutName previous+  let next =+        LayoutSnapshot+          { layoutBackend = LayoutBackendHyprland,+            layoutRevision = layoutRevision previous + 1,+            layoutName = name+          }+  liftIO $ do+    _ <- swapMVar stateVar next+    atomically $ writeTChan stateChan next++buildHyprlandLayoutSnapshot :: TaffyIO T.Text+buildHyprlandLayoutSnapshot = do+  client <- getHyprlandClient+  result <- liftIO $ HyprAPI.getHyprlandActiveWorkspace client+  case result of+    Left err ->+      wLog WARNING ("hyprctl activeworkspace failed: " <> show err) >> pure ""+    Right workspaceInfo ->+      pure $ fromMaybe "" $ HyprTypes.hyprActiveWorkspaceLayout workspaceInfo

@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------++-----------------------------------------------------------------------------++-- |+-- Module      : System.Taffybar.Information.Layout.Model+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan A. Malison+-- Stability   : unstable+-- Portability : unportable+--+-- Backend-agnostic layout model shared by layout widgets and providers.+module System.Taffybar.Information.Layout.Model+  ( LayoutBackend (..),+    LayoutSnapshot (..),+  )+where++import Data.Text (Text)+import Data.Word (Word64)++data LayoutBackend+  = LayoutBackendXMonad+  | LayoutBackendHyprland+  deriving (Eq, Show)++data LayoutSnapshot = LayoutSnapshot+  { layoutBackend :: LayoutBackend,+    layoutRevision :: Word64,+    layoutName :: Text+  }+  deriving (Eq, Show)

@@ -6,6 +6,8 @@   ) where +import qualified Data.ByteString.Char8 as BS8+ toMB :: String -> Double toMB size = (read size :: Double) / 1024 @@ -51,10 +53,13 @@       _ -> memInfo parseLines _ memInfo = memInfo +readAsciiFileStrict :: FilePath -> IO String+readAsciiFileStrict = fmap BS8.unpack . BS8.readFile+ -- | Read @/proc/meminfo@ and return memory/swap totals and usage ratios in MiB. parseMeminfo :: IO MemoryInfo parseMeminfo = do-  s <- readFile "/proc/meminfo"+  s <- readAsciiFileStrict "/proc/meminfo"   let m = parseLines (lines s) emptyMemoryInfo       rest = memoryFree m + memoryBuffer m + memoryCache m       used = memoryTotal m - rest

@@ -70,6 +70,7 @@ import System.Taffybar.Information.SafeX11 (safeGetGeometry) import System.Taffybar.Information.Workspaces.Model import System.Taffybar.Information.X11DesktopInfo (X11Property, X11Window, getDisplay)+import qualified System.Taffybar.Information.X11DesktopInfo as X11  data EWMHWorkspaceProviderConfig = EWMHWorkspaceProviderConfig   { workspaceSnapshotGetter :: TaffyIO (Bool, [WorkspaceInfo]),@@ -81,7 +82,8 @@ defaultEWMHWorkspaceProviderConfig =   EWMHWorkspaceProviderConfig     { workspaceSnapshotGetter = buildEWMHWorkspaceSnapshot,-      workspaceUpdateEvents = allEWMHProperties \\ [ewmhWMIcon],+      workspaceUpdateEvents =+        X11.xmonadVisibleWorkspaces : (allEWMHProperties \\ [ewmhWMIcon, X11.xmonadVisibleWorkspaces]),       workspaceUpdateRateLimitMicroseconds = 100000     } 

@@ -0,0 +1,235 @@+-----------------------------------------------------------------------------++-----------------------------------------------------------------------------++-- |+-- Module      : System.Taffybar.Information.Workspaces.Support+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan A. Malison+-- Stability   : unstable+-- Portability : unportable+--+-- Shared workspace/window helpers used by multiple widgets.+module System.Taffybar.Information.Workspaces.Support+  ( WindowIconPixbufGetter,+    sortWindowsByPosition,+    sortWindowsByStackIndex,+    scaledWindowIconPixbufGetter,+    constantScaleWindowIconPixbufGetter,+    handleIconGetterException,+    getWindowIconPixbufFromClassHints,+    getWindowIconPixbufFromDesktopEntry,+    getWindowIconPixbufFromClass,+    getWindowIconPixbufByClassHints,+    getWindowIconPixbufFromChrome,+    getWindowIconPixbufFromEWMH,+    defaultGetWindowIconPixbuf,+    unscaledDefaultGetWindowIconPixbuf,+    addCustomIconsToDefaultWithFallbackByPath,+    addCustomIconsAndFallback,+    defaultOnWorkspaceClick,+    defaultOnWorkspaceClickEWMH,+    defaultOnWindowClick,+  )+where++import Control.Exception.Enclosed (catchAny)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Reader (asks)+import Data.Int (Int32)+import Data.List (elemIndex, sortBy, sortOn)+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk+import System.Log.Logger (Priority (..), logM)+import System.Taffybar.Context (Backend (..), TaffyIO, backend, runX11Def)+import System.Taffybar.Hyprland (getHyprlandClient)+import System.Taffybar.Information.EWMHDesktopInfo+  ( WorkspaceId (WorkspaceId),+    focusWindow,+    getWindowsStacking,+    switchToWorkspace,+  )+import qualified System.Taffybar.Information.Hyprland.API as HyprAPI+import System.Taffybar.Information.Workspaces.Model+import System.Taffybar.Util (getPixbufFromFilePath, (<|||>))+import System.Taffybar.Widget.Util+  ( handlePixbufGetterException,+    scaledPixbufGetter,+  )+import System.Taffybar.WindowIcon+  ( getCachedIconPixBufFromEWMH,+    getCachedWindowIconFromClasses,+    getCachedWindowIconFromDesktopEntryByClasses,+    getPixBufFromChromeData,+  )++type WindowIconPixbufGetter = Int32 -> WindowInfo -> TaffyIO (Maybe Gdk.Pixbuf)++sortWindowsByPosition :: [WindowInfo] -> [WindowInfo]+sortWindowsByPosition =+  sortOn $ \windowInfo ->+    ( windowMinimized windowInfo,+      fromMaybe (999999999, 999999999) (windowPosition windowInfo)+    )++sortWindowsByStackIndex :: [WindowInfo] -> TaffyIO [WindowInfo]+sortWindowsByStackIndex windows = do+  stackingWindows <- runX11Def [] getWindowsStacking+  let getStackIdx windowInfo =+        case windowIdentity windowInfo of+          X11WindowIdentity wid -> fromMaybe (-1) $ elemIndex (fromIntegral wid) stackingWindows+          HyprlandWindowIdentity _ -> -1+      compareWindowData a b = compare (getStackIdx b) (getStackIdx a)+  pure $ sortBy compareWindowData windows++scaledWindowIconPixbufGetter :: WindowIconPixbufGetter -> WindowIconPixbufGetter+scaledWindowIconPixbufGetter = scaledPixbufGetter++constantScaleWindowIconPixbufGetter ::+  Int32 -> WindowIconPixbufGetter -> WindowIconPixbufGetter+constantScaleWindowIconPixbufGetter constantSize getter =+  const $ scaledWindowIconPixbufGetter getter constantSize++handleIconGetterException :: WindowIconPixbufGetter -> WindowIconPixbufGetter+handleIconGetterException = handlePixbufGetterException wLog++getWindowIconPixbufFromClassHints :: WindowIconPixbufGetter+getWindowIconPixbufFromClassHints =+  getWindowIconPixbufFromDesktopEntry <|||> getWindowIconPixbufFromClass++getWindowIconPixbufFromDesktopEntry :: WindowIconPixbufGetter+getWindowIconPixbufFromDesktopEntry = handleIconGetterException $ \size winInfo ->+  tryHints size (map T.unpack (windowClassHints winInfo))+  where+    tryHints _ [] = pure Nothing+    tryHints requestedSize (klass : rest) = do+      fromDesktopEntry <- getCachedWindowIconFromDesktopEntryByClasses requestedSize klass+      case fromDesktopEntry of+        Just _ -> pure fromDesktopEntry+        Nothing -> tryHints requestedSize rest++getWindowIconPixbufFromClass :: WindowIconPixbufGetter+getWindowIconPixbufFromClass = handleIconGetterException $ \size winInfo ->+  tryHints size (map T.unpack (windowClassHints winInfo))+  where+    tryHints _ [] = pure Nothing+    tryHints requestedSize (klass : rest) = do+      fromClass <- getCachedWindowIconFromClasses requestedSize klass+      case fromClass of+        Just _ -> pure fromClass+        Nothing -> tryHints requestedSize rest++getWindowIconPixbufByClassHints :: WindowIconPixbufGetter+getWindowIconPixbufByClassHints = getWindowIconPixbufFromClassHints++getWindowIconPixbufFromChrome :: WindowIconPixbufGetter+getWindowIconPixbufFromChrome _ windowData =+  case windowIdentity windowData of+    X11WindowIdentity wid -> getPixBufFromChromeData (fromIntegral wid)+    HyprlandWindowIdentity _ -> pure Nothing++getWindowIconPixbufFromEWMH :: WindowIconPixbufGetter+getWindowIconPixbufFromEWMH = handleIconGetterException $ \size windowData ->+  case windowIdentity windowData of+    X11WindowIdentity wid -> getCachedIconPixBufFromEWMH size (fromIntegral wid)+    HyprlandWindowIdentity _ -> pure Nothing++defaultGetWindowIconPixbuf :: WindowIconPixbufGetter+defaultGetWindowIconPixbuf =+  scaledWindowIconPixbufGetter unscaledDefaultGetWindowIconPixbuf++unscaledDefaultGetWindowIconPixbuf :: WindowIconPixbufGetter+unscaledDefaultGetWindowIconPixbuf =+  getWindowIconPixbufFromDesktopEntry+    <|||> getWindowIconPixbufFromClass+    <|||> getWindowIconPixbufFromEWMH++addCustomIconsToDefaultWithFallbackByPath ::+  (WindowInfo -> Maybe FilePath) ->+  FilePath ->+  WindowIconPixbufGetter+addCustomIconsToDefaultWithFallbackByPath getCustomIconPath fallbackPath =+  addCustomIconsAndFallback+    getCustomIconPath+    (const $ liftIO $ getPixbufFromFilePath fallbackPath)+    unscaledDefaultGetWindowIconPixbuf++addCustomIconsAndFallback ::+  (WindowInfo -> Maybe FilePath) ->+  (Int32 -> TaffyIO (Maybe Gdk.Pixbuf)) ->+  WindowIconPixbufGetter ->+  WindowIconPixbufGetter+addCustomIconsAndFallback getCustomIconPath fallback defaultGetter =+  scaledWindowIconPixbufGetter $+    getCustomIcon <|||> defaultGetter <|||> (\size _ -> fallback size)+  where+    getCustomIcon :: WindowIconPixbufGetter+    getCustomIcon _ windowInfo =+      maybe (pure Nothing) (liftIO . getPixbufFromFilePath) $+        getCustomIconPath windowInfo++defaultOnWorkspaceClick :: WorkspaceInfo -> TaffyIO ()+defaultOnWorkspaceClick workspaceInfo = do+  backendType <- asks backend+  case backendType of+    BackendX11 -> defaultOnWorkspaceClickEWMH workspaceInfo+    BackendWayland -> defaultOnWorkspaceClickHyprland workspaceInfo++defaultOnWorkspaceClickHyprland :: WorkspaceInfo -> TaffyIO ()+defaultOnWorkspaceClickHyprland workspaceInfo = do+  client <- getHyprlandClient+  let targetText = workspaceName (workspaceIdentity workspaceInfo)+  case HyprAPI.mkHyprlandWorkspaceTarget targetText of+    Left err ->+      wLog WARNING $+        "Failed to build Hyprland workspace target for " <> show targetText <> ": " <> show err+    Right target -> do+      result <- liftIO $ HyprAPI.dispatchHyprland client (HyprAPI.DispatchWorkspace target)+      case result of+        Left err ->+          wLog WARNING $+            "Failed to switch workspace via Hyprland dispatch: " <> show err+        Right _ -> pure ()++defaultOnWorkspaceClickEWMH :: WorkspaceInfo -> TaffyIO ()+defaultOnWorkspaceClickEWMH workspaceInfo =+  case workspaceNumericId (workspaceIdentity workspaceInfo) of+    Nothing ->+      wLog WARNING $+        "Workspace has no numeric id for EWMH switch: " <> show (workspaceIdentity workspaceInfo)+    Just workspaceId ->+      runX11Def () (switchToWorkspace (WorkspaceId workspaceId))+        `catchAny` \err ->+          wLog WARNING $+            "Failed to switch EWMH workspace " <> show workspaceId <> ": " <> show err++defaultOnWindowClick :: WindowInfo -> TaffyIO ()+defaultOnWindowClick windowInfo =+  case windowIdentity windowInfo of+    X11WindowIdentity wid ->+      runX11Def () (focusWindow (fromIntegral wid))+        `catchAny` \err ->+          wLog WARNING $+            "Failed to focus X11 window " <> show wid <> ": " <> show err+    HyprlandWindowIdentity address -> do+      client <- getHyprlandClient+      case HyprAPI.mkHyprlandAddress address of+        Left err ->+          wLog WARNING $+            "Failed to build Hyprland window address " <> show address <> ": " <> show err+        Right hyprlandAddress -> do+          result <-+            liftIO $+              HyprAPI.dispatchHyprland client (HyprAPI.DispatchFocusWindowAddress hyprlandAddress)+          case result of+            Left err ->+              wLog WARNING $+                "Failed to focus Hyprland window " <> show address <> ": " <> show err+            Right _ -> pure ()++wLog :: Priority -> String -> TaffyIO ()+wLog level message =+  liftIO $ logM "System.Taffybar.Information.Workspaces.Support" level message

@@ -54,6 +54,7 @@     -- ** Getters     isWindowUrgent,     getPrimaryOutputNumber,+    xmonadVisibleWorkspaces,     getVisibleTags,      -- ** Operations@@ -206,13 +207,18 @@   hints <- fetchWindowHints window   return $ testBit (wmh_flags hints) urgencyHintBit +-- | XMonad-specific root-window property updated by @pagerHints@ with the set+-- of visible workspace names.+xmonadVisibleWorkspaces :: String+xmonadVisibleWorkspaces = "_XMONAD_VISIBLE_WORKSPACES"+ -- | Retrieve the value of the special @_XMONAD_VISIBLE_WORKSPACES@ -- hint set by the 'XMonad.Hooks.TaffybarPagerHints.pagerHints' hook -- provided by [xmonad-contrib]("XMonad.Hooks.TaffybarPagerHints") -- (see module documentation for instructions on how to do this), or -- an empty list of strings if the @pagerHints@ hook is not available. getVisibleTags :: X11Property [String]-getVisibleTags = readAsListOfString Nothing "_XMONAD_VISIBLE_WORKSPACES"+getVisibleTags = readAsListOfString Nothing xmonadVisibleWorkspaces  -- | Return the 'Atom' with the given name. getAtom :: String -> X11Property Atom

@@ -79,6 +79,8 @@    -- * "System.Taffybar.Widget.SimpleClock"   , module System.Taffybar.Widget.SimpleClock+  -- * "System.Taffybar.Widget.CoordinatedClock"+  , module System.Taffybar.Widget.CoordinatedClock    -- * "System.Taffybar.Widget.SimpleCommandButton"   , module System.Taffybar.Widget.SimpleCommandButton@@ -129,6 +131,7 @@ import System.Taffybar.Widget.PowerProfiles import System.Taffybar.Widget.SNITray import System.Taffybar.Widget.SNITray.PrioritizedCollapsible+import System.Taffybar.Widget.CoordinatedClock import System.Taffybar.Widget.SimpleClock import System.Taffybar.Widget.SimpleCommandButton import System.Taffybar.Widget.WakeupDebug

@@ -18,8 +18,9 @@ -- available. module System.Taffybar.Widget.CPUMonitor where -import Control.Monad.IO.Class+import Control.Monad.IO.Class (liftIO) import qualified GI.Gtk+import System.Taffybar.Context (TaffyIO) import System.Taffybar.Information.CPU2 (CPULoad (..), getCPULoadChan) import System.Taffybar.Widget.Generic.ChannelGraph import System.Taffybar.Widget.Generic.Graph@@ -28,18 +29,18 @@ -- | Creates a new CPU monitor. This is a channel-driven graph fed by CPU load -- samples for one core (or all cores when "cpu" is selected). cpuMonitorNew ::-  (MonadIO m) =>   -- | Configuration data for the Graph.   GraphConfig ->   -- | Polling period (in seconds).   Double ->   -- | Name of the core to watch (e.g. \"cpu\", \"cpu0\").   String ->-  m GI.Gtk.Widget-cpuMonitorNew cfg interval cpu = liftIO $ do+  TaffyIO GI.Gtk.Widget+cpuMonitorNew cfg interval cpu = do   chan <- getCPULoadChan cpu interval-  channelGraphNew cfg chan toSample-    >>= (`widgetSetClassGI` "cpu-monitor")+  liftIO $+    channelGraphNew cfg chan toSample+      >>= (`widgetSetClassGI` "cpu-monitor")  toSample :: CPULoad -> IO [Double] toSample CPULoad {cpuTotalLoad = totalLoad, cpuSystemLoad = systemLoad} =

@@ -0,0 +1,175 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Text clock widget driven by coordinated wakeup channels.+module System.Taffybar.Widget.CoordinatedClock+  ( coordinatedTextClockNew,+    coordinatedTextClockNewWith,+    ClockConfig (..),+    ClockUpdateStrategy (..),+    defaultClockConfig,+  )+where++import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TChan (dupTChan, readTChan)+import Control.Exception.Enclosed (catchAny)+import Control.Monad (forever, void)+import Control.Monad.IO.Class (liftIO)+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import Data.Time.Calendar (toGregorian)+import qualified Data.Time.Clock as Clock+import Data.Time.Format (formatTime)+import Data.Time.LocalTime+import qualified Data.Time.Locale.Compat as L+import qualified GI.Gdk as Gdk+import GI.Gtk+import System.Log.Logger (Priority (WARNING))+import System.Taffybar.Context (TaffyIO)+import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay)+import System.Taffybar.Util (logPrintF, postGUIASync)+import System.Taffybar.Widget.SimpleClock+  ( ClockConfig (..),+    ClockUpdateStrategy (..),+    defaultClockConfig,+    textClockNewWith,+  )+import System.Taffybar.Widget.Util++-- | Create a coordinated-wakeup clock with fixed-interval updates.+coordinatedTextClockNew ::+  Maybe L.TimeLocale ->+  String ->+  Double ->+  TaffyIO Widget+coordinatedTextClockNew userLocale format interval =+  coordinatedTextClockNewWith $+    defaultClockConfig+      { clockTimeLocale = userLocale,+        clockFormatString = format,+        clockUpdateStrategy = ConstantInterval interval+      }++-- | Create a coordinated-wakeup clock using the same 'ClockConfig' as+-- 'textClockNewWith'. If the strategy cannot be represented as a coordinated+-- fixed interval, falls back to 'textClockNewWith'.+coordinatedTextClockNewWith :: ClockConfig -> TaffyIO Widget+coordinatedTextClockNewWith cfg@ClockConfig {clockUpdateStrategy = updateStrategy} =+  case coordinatedIntervalSeconds updateStrategy of+    Nothing -> textClockNewWith cfg+    Just intervalSeconds -> do+      wakeupChan <- getWakeupChannelForDelay intervalSeconds+      liftIO $ do+        let getTZ = maybe getCurrentTimeZone return (clockTimeZone cfg)+            locale = fromMaybe L.defaultTimeLocale (clockTimeLocale cfg)++            getUserZonedTime =+              utcToZonedTime <$> getTZ <*> Clock.getCurrentTime++            doTimeFormat zonedTime =+              T.pack $ formatTime locale (clockFormatString cfg) zonedTime++            getDisplayText = do+              zonedTime <- getUserZonedTime+              pure $ case updateStrategy of+                ConstantInterval _ -> doTimeFormat zonedTime+                RoundedTargetInterval roundSeconds _ ->+                  doTimeFormat $ roundedZonedTime roundSeconds zonedTime++            refreshClockLabel label =+              catchAny+                ( do+                    labelText <- getDisplayText+                    postGUIASync $ labelSetMarkup label labelText+                )+                ( logPrintF+                    logPath+                    WARNING+                    "Coordinated clock update failed: %s"+                )++        label <- labelNew (Nothing :: Maybe T.Text)+        _ <- widgetSetClassGI label "text-clock-label"+        void $ refreshClockLabel label++        _ <- onWidgetRealize label $ do+          ourWakeupChan <- atomically $ dupTChan wakeupChan+          threadId <- forkIO $ forever $ do+            void $ atomically $ readTChan ourWakeupChan+            void $ refreshClockLabel label+          void $ onWidgetUnrealize label $ killThread threadId++        ebox <- eventBoxNew+        _ <- widgetSetClassGI ebox "text-clock"+        containerAdd ebox label+        eventBoxSetVisibleWindow ebox False+        cal <- makeCalendar getTZ+        _ <-+          onWidgetButtonPressEvent ebox $+            onClick [Gdk.EventTypeButtonPress] $+              toggleCalendar label cal+        widgetShowAll ebox+        toWidget ebox++coordinatedIntervalSeconds :: ClockUpdateStrategy -> Maybe Double+coordinatedIntervalSeconds = \case+  ConstantInterval interval+    | interval > 0 -> Just interval+    | otherwise -> Nothing+  RoundedTargetInterval roundSeconds offset+    | roundSeconds > 0 && offset == 0 -> Just (fromIntegral roundSeconds)+    | otherwise -> Nothing++roundedZonedTime :: Int -> ZonedTime -> ZonedTime+roundedZonedTime roundSeconds zonedTime+  | roundSeconds <= 0 = zonedTime+  | otherwise =+      zonedTime+        { zonedTimeToLocalTime =+            if seconds `mod` roundSeconds > roundSeconds `div` 2+              then addLocalTime roundSecondsDiffTime baseLocalTime+              else baseLocalTime+        }+  where+    roundSecondsDiffTime = fromIntegral roundSeconds+    localTime = zonedTimeToLocalTime zonedTime+    ourLocalTimeOfDay = localTimeOfDay localTime+    seconds = round $ todSec ourLocalTimeOfDay+    secondsFactor = seconds `div` roundSeconds+    displaySeconds = secondsFactor * roundSeconds+    baseLocalTimeOfDay =+      ourLocalTimeOfDay {todSec = fromIntegral displaySeconds}+    baseLocalTime =+      localTime {localTimeOfDay = baseLocalTimeOfDay}++makeCalendar :: IO TimeZone -> IO Window+makeCalendar tzfn = do+  container <- windowNew WindowTypeToplevel+  cal <- calendarNew+  containerAdd container cal+  _ <- onWidgetShow container $ resetCalendarDate cal tzfn+  _ <- onWidgetDeleteEvent container $ \_ -> widgetHide container >> return True+  return container++resetCalendarDate :: Calendar -> IO TimeZone -> IO ()+resetCalendarDate cal tzfn = do+  tz <- tzfn+  current <- Clock.getCurrentTime+  let (y, m, d) = toGregorian $ localDay $ utcToLocalTime tz current+  calendarSelectMonth cal (fromIntegral m - 1) (fromIntegral y)+  calendarSelectDay cal (fromIntegral d)++toggleCalendar :: (IsWidget w) => w -> Window -> IO Bool+toggleCalendar w c = do+  isVis <- widgetGetVisible c+  if isVis+    then widgetHide c+    else do+      attachPopup w "Calendar" c+      displayPopup w c+  return True++logPath :: String+logPath = "System.Taffybar.Widget.CoordinatedClock"

@@ -11,81 +11,18 @@   ) where -import qualified Control.Concurrent.MVar as MV import Control.Monad import Control.Monad.IO.Class import Data.Int-import qualified GI.Cairo.Render as C-import GI.Cairo.Render.Connector-import qualified GI.Gdk as Gdk-import qualified GI.GdkPixbuf.Enums as GdkPixbuf import GI.GdkPixbuf.Objects.Pixbuf as Gdk import qualified GI.Gtk as Gtk-import System.Taffybar.Widget.Generic.AutoSizeImage+import Graphics.UI.GIGtkScalingImage+  ( AutoFillCache (..),+    fitPixbufToBox,+  )+import qualified Graphics.UI.GIGtkScalingImage as Scaling import System.Taffybar.Widget.Util --- | Cached sizing/scaling state for an auto-fill image widget.-data AutoFillCache = AutoFillCache-  { afRequestSize :: Int32,-    afScaleFactor :: Int32,-    afInsets :: BorderInfo,-    afContentWidth :: Int32,-    afContentHeight :: Int32,-    afSourcePixbuf :: Maybe Gdk.Pixbuf,-    afScaledPixbuf :: Maybe Gdk.Pixbuf,-    afOffsetX :: Double,-    afOffsetY :: Double-  }---- | Scale and center a pixbuf inside the allocated widget content box.------ Returns content width/height, draw offsets, and an optionally scaled pixbuf--- (GDK may fail and return @Nothing@).-fitPixbufToBox ::-  -- | scale factor-  Int32 ->-  BorderInfo ->-  -- | allocated width (logical px)-  Int32 ->-  -- | allocated height (logical px)-  Int32 ->-  Gdk.Pixbuf ->-  IO (Int32, Int32, Double, Double, Maybe Gdk.Pixbuf)-fitPixbufToBox scaleFactor insets allocW allocH pixbuf = do-  pbW' <- Gdk.getPixbufWidth pixbuf-  pbH' <- Gdk.getPixbufHeight pixbuf--  let contentW = max 1 $ allocW - fromIntegral (borderWidth insets)-      contentH = max 1 $ allocH - fromIntegral (borderHeight insets)--      targetWDev = max 1 $ contentW * scaleFactor-      targetHDev = max 1 $ contentH * scaleFactor--      pbW = fromIntegral pbW' :: Double-      pbH = fromIntegral pbH' :: Double-      targetW = fromIntegral targetWDev :: Double-      targetH = fromIntegral targetHDev :: Double--      scale =-        if pbW <= 0 || pbH <= 0-          then 1-          else min (targetW / pbW) (targetH / pbH)--      drawWDev = max 1 $ floor (pbW * scale)-      drawHDev = max 1 $ floor (pbH * scale)--      drawWLogical = fromIntegral drawWDev / fromIntegral scaleFactor-      drawHLogical = fromIntegral drawHDev / fromIntegral scaleFactor--      leftInset = fromIntegral (borderLeft insets) :: Double-      topInset = fromIntegral (borderTop insets) :: Double-      offsetX = leftInset + (fromIntegral contentW - drawWLogical) / 2-      offsetY = topInset + (fromIntegral contentH - drawHLogical) / 2--  scaledM <- Gdk.pixbufScaleSimple pixbuf drawWDev drawHDev GdkPixbuf.InterpTypeBilinear-  -- GDK can return NULL; treat that as "draw nothing".-  pure (contentW, contentH, offsetX, offsetY, scaledM)- -- | A draw-based alternative to 'autoSizeImage' that avoids resize loops and -- naturally responds to CSS changes. The widget will always draw the current -- pixbuf scaled to fit its allocated area (minus padding+border).@@ -99,126 +36,9 @@   Gtk.Orientation ->   m (IO ()) autoFillImage drawArea getPixbuf orientation = liftIO $ do-  case orientation of-    Gtk.OrientationHorizontal -> Gtk.widgetSetVexpand drawArea True-    _ -> Gtk.widgetSetHexpand drawArea True--  -- Keep existing styling working.   void $ widgetSetClassGI drawArea "auto-size-image"   void $ widgetSetClassGI drawArea "auto-fill-image"--  -- Ensure the widget has a non-zero natural size even before the first-  -- allocation.-  Gtk.widgetSetSizeRequest drawArea 16 16--  -- Cache is only accessed from the GTK main loop via signal handlers.-  cacheVar <--    MV.newMVar-      AutoFillCache-        { afRequestSize = 0,-          afScaleFactor = 1,-          afInsets = borderInfoZero,-          afContentWidth = 1,-          afContentHeight = 1,-          afSourcePixbuf = Nothing,-          afScaledPixbuf = Nothing,-          afOffsetX = 0,-          afOffsetY = 0-        }--  let recompute force = do-        allocation <- Gtk.widgetGetAllocation drawArea-        allocW <- Gdk.getRectangleWidth allocation-        allocH <- Gdk.getRectangleHeight allocation--        -- CSS can change dynamically (taffybar supports live CSS reload), so we-        -- recompute insets every time we recompute sizing.-        insets <- getInsetInfo drawArea-        scaleFactor <- Gtk.widgetGetScaleFactor drawArea--        let contentW = max 1 $ allocW - fromIntegral (borderWidth insets)-            contentH = max 1 $ allocH - fromIntegral (borderHeight insets)-            requestSize =-              case orientation of-                Gtk.OrientationHorizontal -> contentH-                _ -> contentW--        -- Update the widget's natural size so it won't collapse to 0 when packed-        -- without expand.-        Gtk.widgetSetSizeRequest-          drawArea-          (fromIntegral requestSize + fromIntegral (borderWidth insets))-          (fromIntegral requestSize + fromIntegral (borderHeight insets))--        old <- MV.readMVar cacheVar-        srcFresh <--          if force || requestSize /= afRequestSize old-            then getPixbuf requestSize-            else pure Nothing--        -- If the getter fails transiently, keep drawing the last known pixbuf.-        let src =-              case srcFresh of-                Just pb -> Just pb-                Nothing -> afSourcePixbuf old--        let needsRefit =-              force-                || requestSize /= afRequestSize old-                || scaleFactor /= afScaleFactor old-                || insets /= afInsets old-                || contentW /= afContentWidth old-                || contentH /= afContentHeight old--        when needsRefit $ do-          newCache <--            case src of-              Nothing ->-                pure-                  old-                    { afRequestSize = requestSize,-                      afScaleFactor = scaleFactor,-                      afInsets = insets,-                      afContentWidth = contentW,-                      afContentHeight = contentH,-                      afSourcePixbuf = Nothing,-                      afScaledPixbuf = Nothing,-                      afOffsetX = 0,-                      afOffsetY = 0-                    }-              Just pb -> do-                (cw, ch, ox, oy, scaledM) <--                  fitPixbufToBox (max 1 scaleFactor) insets allocW allocH pb-                pure-                  old-                    { afRequestSize = requestSize,-                      afScaleFactor = max 1 scaleFactor,-                      afInsets = insets,-                      afContentWidth = cw,-                      afContentHeight = ch,-                      afSourcePixbuf = Just pb,-                      afScaledPixbuf = scaledM,-                      afOffsetX = ox,-                      afOffsetY = oy-                    }--          void $ MV.swapMVar cacheVar newCache-          Gtk.widgetQueueDraw drawArea--  -- Redraw when GTK allocates or when style changes.-  void $ Gtk.onWidgetSizeAllocate drawArea $ \_ -> recompute False-  void $ Gtk.onWidgetStyleUpdated drawArea $ recompute True--  void $ Gtk.onWidgetDraw drawArea $ \ctx -> do-    st <- MV.readMVar cacheVar-    case afScaledPixbuf st of-      Nothing -> pure True-      Just pb -> do-        Gdk.cairoSetSourcePixbuf ctx pb (afOffsetX st) (afOffsetY st)-        renderWithContext C.paint ctx-        pure True--  pure $ recompute True+  Scaling.autoFillImage drawArea getPixbuf orientation  -- | Convenience constructor for 'autoFillImage'. autoFillImageNew ::

@@ -26,7 +26,16 @@ import qualified GI.Gdk as Gdk import GI.GdkPixbuf.Objects.Pixbuf as Gdk import qualified GI.Gtk as Gtk-import StatusNotifier.Tray (scalePixbufToSize)+import Graphics.UI.GIGtkScalingImage+  ( BorderInfo (..),+    borderHeight,+    borderInfoZero,+    borderWidth,+    getBorderInfo,+    getContentAllocation,+    getInsetInfo,+    scalePixbufToSize,+  ) import System.Log.Logger import System.Taffybar.Util import System.Taffybar.Widget.Util@@ -45,109 +54,6 @@  imageLog :: Priority -> String -> IO () imageLog = logM "System.Taffybar.Widget.Generic.AutoSizeImage"--borderFunctions :: [Gtk.StyleContext -> [Gtk.StateFlags] -> IO Gtk.Border]-borderFunctions =-  [ Gtk.styleContextGetPadding,-    Gtk.styleContextGetMargin,-    Gtk.styleContextGetBorder-  ]---- Insets that are inside a widget's allocation and should be respected when--- drawing inside it.-insetFunctions :: [Gtk.StyleContext -> [Gtk.StateFlags] -> IO Gtk.Border]-insetFunctions =-  [ Gtk.styleContextGetPadding,-    Gtk.styleContextGetBorder-  ]---- | Aggregate border/padding/margin dimensions for a widget.-data BorderInfo = BorderInfo-  { borderTop :: Int16,-    borderBottom :: Int16,-    borderLeft :: Int16,-    borderRight :: Int16-  }-  deriving (Show, Eq)---- | Zero-valued 'BorderInfo'.-borderInfoZero :: BorderInfo-borderInfoZero = BorderInfo 0 0 0 0---- | Total horizontal border extent.--- This includes left + right values.-borderWidth, borderHeight :: BorderInfo -> Int16-borderWidth borderInfo = borderLeft borderInfo + borderRight borderInfo---- | Total vertical border extent.--- This includes top + bottom values.-borderHeight borderInfo = borderTop borderInfo + borderBottom borderInfo--toBorderInfo :: (MonadIO m) => Gtk.Border -> m BorderInfo-toBorderInfo border =-  BorderInfo-    <$> Gtk.getBorderTop border-    <*> Gtk.getBorderBottom border-    <*> Gtk.getBorderLeft border-    <*> Gtk.getBorderRight border--addBorderInfo :: BorderInfo -> BorderInfo -> BorderInfo-addBorderInfo-  (BorderInfo t1 b1 l1 r1)-  (BorderInfo t2 b2 l2 r2) =-    BorderInfo (t1 + t2) (b1 + b2) (l1 + l2) (r1 + r2)---- | Get the total size of the border (the sum of its assigned margin, border--- and padding values) that will be drawn for a widget as a "BorderInfo" record.-getBorderInfo :: (MonadIO m, Gtk.IsWidget a) => a -> m BorderInfo-getBorderInfo widget = liftIO $ do-  stateFlags <- Gtk.widgetGetStateFlags widget-  styleContext <- Gtk.widgetGetStyleContext widget--  let getBorderInfoFor borderFn =-        borderFn styleContext stateFlags >>= toBorderInfo-      combineBorderInfo lastSum fn =-        addBorderInfo lastSum <$> getBorderInfoFor fn--  foldM combineBorderInfo borderInfoZero borderFunctions---- | Get the size of the padding+border drawn inside a widget's allocation.-getInsetInfo :: (MonadIO m, Gtk.IsWidget a) => a -> m BorderInfo-getInsetInfo widget = liftIO $ do-  stateFlags <- Gtk.widgetGetStateFlags widget-  styleContext <- Gtk.widgetGetStyleContext widget--  let getBorderInfoFor borderFn =-        borderFn styleContext stateFlags >>= toBorderInfo-      combineBorderInfo lastSum fn =-        addBorderInfo lastSum <$> getBorderInfoFor fn--  foldM combineBorderInfo borderInfoZero insetFunctions---- | Get the actual allocation for a "Gtk.Widget", accounting for the size of--- its CSS assined margin, border and padding values.-getContentAllocation ::-  (MonadIO m, Gtk.IsWidget a) =>-  a -> BorderInfo -> m Gdk.Rectangle-getContentAllocation widget borderInfo = do-  allocation <- Gtk.widgetGetAllocation widget-  currentWidth <- Gdk.getRectangleWidth allocation-  currentHeight <- Gdk.getRectangleHeight allocation-  currentX <- Gdk.getRectangleX allocation-  currentY <- Gdk.getRectangleX allocation--  Gdk.setRectangleWidth allocation $-    max 1 $-      currentWidth - fromIntegral (borderWidth borderInfo)-  Gdk.setRectangleHeight allocation $-    max 1 $-      currentHeight - fromIntegral (borderHeight borderInfo)-  Gdk.setRectangleX allocation $-    currentX + fromIntegral (borderLeft borderInfo)-  Gdk.setRectangleY allocation $-    currentY + fromIntegral (borderTop borderInfo)--  return allocation  -- | Automatically update the "Gdk.Pixbuf" of a "Gtk.Image" using the provided -- action whenever the "Gtk.Image" is allocated. Returns an action that forces a

@@ -84,7 +84,8 @@     graphDataStyles :: [GraphStyle],     -- | The number of data points to retain for each data set (default 20)     graphHistorySize :: Int,-    -- | May contain Pango markup (default @Nothing@)+    -- | Optional label rendered inside the graph area using a GTK overlay.+    -- May contain Pango markup. (default @Nothing@)     graphLabel :: Maybe T.Text,     -- | The width (in pixels) of the graph widget (default 50)     graphWidth :: Int,@@ -316,9 +317,11 @@     Just labelText -> do       overlay <- Gtk.overlayNew       label <- Gtk.labelNew Nothing+      _ <- widgetSetClassGI label (T.pack "graph-label")       Gtk.labelSetMarkup label labelText       Gtk.containerAdd overlay box       Gtk.overlayAddOverlay overlay label+      Gtk.overlaySetOverlayPassThrough overlay label True       Gtk.toWidget overlay    Gtk.widgetShowAll widget

@@ -19,7 +19,7 @@ import Data.Typeable import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk import qualified GI.Gtk as Gtk-import StatusNotifier.Tray (scalePixbufToSize)+import Graphics.UI.GIGtkScalingImage (scalePixbufToSize) import System.Taffybar.Context import System.Taffybar.Widget.Generic.AutoFillImage (autoFillImage) import System.Taffybar.Widget.Generic.AutoSizeImage

@@ -22,15 +22,13 @@   ) where -import Control.Applicative ((<|>))-import Control.Concurrent (killThread)+import qualified Control.Concurrent.MVar as MV+import Control.Concurrent.STM.TChan (TChan) import Control.Monad (void)+import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class import Control.Monad.Trans.Reader-import Data.Aeson (FromJSON (..), withObject, (.:?)) import Data.Default (Default (..))-import Data.Maybe (fromMaybe)-import Data.Text (Text) import qualified Data.Text as T import GI.Gdk import qualified GI.Gtk as Gtk@@ -41,13 +39,18 @@     runHyprlandCommandRawT,   ) import qualified System.Taffybar.Information.Hyprland as Hypr-import System.Taffybar.Information.Wakeup (taffyForeverWithDelay)+import System.Taffybar.Information.Layout.Hyprland+  ( getHyprlandLayoutStateChanAndVar,+  )+import System.Taffybar.Information.Layout.Model import System.Taffybar.Util+import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew) import System.Taffybar.Widget.Util  -- | Configuration for 'hyprlandLayoutNew'. data HyprlandLayoutConfig = HyprlandLayoutConfig   { formatLayout :: T.Text -> TaffyIO T.Text,+    -- | Retained for API compatibility; the widget is now event-driven.     updateIntervalSeconds :: Double,     onLeftClick :: Maybe [String],     onRightClick :: Maybe [String]@@ -70,24 +73,35 @@ hyprlandLayoutNew :: HyprlandLayoutConfig -> TaffyIO Gtk.Widget hyprlandLayoutNew config = do   ctx <- ask+  (stateChan, stateVar) <- hyprlandLayoutStateSource+  initialSnapshot <- liftIO $ MV.readMVar stateVar   label <- lift $ Gtk.labelNew (Nothing :: Maybe T.Text)   _ <- widgetSetClassGI label "layout-label" -  let refresh = do-        layoutText <- getHyprlandLayoutText-        markup <- formatLayout config layoutText-        lift $ postGUIASync $ Gtk.labelSetMarkup label markup+  let renderSnapshot snapshot = do+        markup <- formatLayout config (layoutName snapshot)+        lift $ Gtk.labelSetMarkup label markup -  void refresh-  threadId <- taffyForeverWithDelay (updateIntervalSeconds config) (void refresh)+  void $ renderSnapshot initialSnapshot    ebox <- lift Gtk.eventBoxNew   lift $ Gtk.containerAdd ebox label+  _ <- liftIO $ Gtk.onWidgetRealize ebox $ do+    latestSnapshot <- MV.readMVar stateVar+    void $ runReaderT (renderSnapshot latestSnapshot) ctx+  _ <-+    liftIO $+      channelWidgetNew+        ebox+        stateChan+        (\snapshot -> postGUIASync $ runReaderT (renderSnapshot snapshot) ctx)   _ <- lift $ Gtk.onWidgetButtonPressEvent ebox $ dispatchButtonEvent ctx config-  _ <- lift $ Gtk.onWidgetUnrealize ebox $ killThread threadId   lift $ Gtk.widgetShowAll ebox   Gtk.toWidget ebox +hyprlandLayoutStateSource :: TaffyIO (TChan LayoutSnapshot, MV.MVar LayoutSnapshot)+hyprlandLayoutStateSource = getHyprlandLayoutStateChanAndVar+ -- | Call the configured dispatch action depending on click. dispatchButtonEvent :: Context -> HyprlandLayoutConfig -> EventButton -> IO Bool dispatchButtonEvent context config btn = do@@ -116,40 +130,3 @@             "Failed to dispatch Hyprland command: %s"             (show err)         Right _ -> return ()---- Hyprland JSON helpers--newtype HyprlandActiveWorkspace = HyprlandActiveWorkspace-  { hawLayout :: Maybe Text-  }-  deriving (Show, Eq)--instance FromJSON HyprlandActiveWorkspace where-  parseJSON = withObject "HyprlandActiveWorkspace" $ \v -> do-    layout <- v .:? "layout" <|> v .:? "layoutName" <|> v .:? "layoutname"-    return $ HyprlandActiveWorkspace layout--getHyprlandLayoutText :: TaffyIO T.Text-getHyprlandLayoutText = do-  result <- runHyprctlJson ["-j", "activeworkspace"]-  case result of-    Left err ->-      logPrintF-        "System.Taffybar.Widget.HyprlandLayout"-        WARNING-        "hyprctl activeworkspace failed: %s"-        err-        >> return ""-    Right (HyprlandActiveWorkspace layout) ->-      return $ fromMaybe "" layout--runHyprctlJson :: (FromJSON a) => [String] -> TaffyIO (Either String a)-runHyprctlJson args = do-  let args' =-        case args of-          ("-j" : rest) -> rest-          _ -> args-  result <- runHyprlandCommandJsonT (Hypr.hyprCommandJson args')-  pure $ case result of-    Left err -> Left (show err)-    Right out -> Right out

@@ -13,10 +13,9 @@ -- Stability   : unstable -- Portability : unportable ----- Simple text widget that shows the XMonad layout used in the currently active--- workspace, and that allows to change it by clicking with the mouse:--- left-click to switch to the next layout in the list, right-click to switch to--- the first one (as configured in @xmonad.hs@)+-- Simple text widget that shows the current layout using a backend-specific+-- information provider. Under X11/XMonad it retains the historical click+-- behavior for layout switching. module System.Taffybar.Widget.Layout   ( -- * Usage     -- $usage@@ -26,6 +25,10 @@   ) where +import qualified Control.Concurrent.MVar as MV+import Control.Concurrent.STM.TChan (TChan)+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Data.Default (Default (..))@@ -33,8 +36,16 @@ import GI.Gdk import qualified GI.Gtk as Gtk import System.Taffybar.Context-import System.Taffybar.Information.X11DesktopInfo+import System.Taffybar.Information.Layout.EWMH+  ( getEWMHLayoutStateChanAndVar,+    switchEWMHLayoutBy,+  )+import System.Taffybar.Information.Layout.Hyprland+  ( getHyprlandLayoutStateChanAndVar,+  )+import System.Taffybar.Information.Layout.Model import System.Taffybar.Util+import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew) import System.Taffybar.Widget.Util  -- $usage@@ -68,54 +79,53 @@ instance Default LayoutConfig where   def = defaultLayoutConfig --- | Name of the X11 events to subscribe, and of the hint to look for for--- the name of the current layout.-xLayoutProp :: String-xLayoutProp = "_XMONAD_CURRENT_LAYOUT"---- | Create a new Layout widget that will use the given Pager as--- its source of events. layoutNew :: LayoutConfig -> TaffyIO Gtk.Widget layoutNew config = do   ctx <- ask+  backendType <- asks backend+  (stateChan, stateVar) <- autoLayoutStateSource+  initialSnapshot <- liftIO $ MV.readMVar stateVar   label <- lift $ Gtk.labelNew (Nothing :: Maybe T.Text)   _ <- widgetSetClassGI label "layout-label" -  -- This callback is run in a separate thread and needs to use-  -- postGUIASync-  let callback _ = mapReaderT postGUIASync $ do-        layout <- runX11Def "" $ readAsString Nothing xLayoutProp-        markup <- formatLayout config (T.pack layout)+  let renderSnapshot snapshot = do+        markup <- formatLayout config (layoutName snapshot)         lift $ Gtk.labelSetMarkup label markup -  subscription <- subscribeToPropertyEvents [xLayoutProp] callback+  void $ renderSnapshot initialSnapshot -  do-    ebox <- Gtk.eventBoxNew-    Gtk.containerAdd ebox label-    _ <- Gtk.onWidgetButtonPressEvent ebox $ dispatchButtonEvent ctx-    Gtk.widgetShowAll ebox-    _ <- Gtk.onWidgetUnrealize ebox $ flip runReaderT ctx $ unsubscribe subscription-    Gtk.toWidget ebox+  ebox <- lift Gtk.eventBoxNew+  lift $ Gtk.containerAdd ebox label+  _ <- liftIO $ Gtk.onWidgetRealize ebox $ do+    latestSnapshot <- MV.readMVar stateVar+    void $ runReaderT (renderSnapshot latestSnapshot) ctx+  _ <-+    liftIO $+      channelWidgetNew+        ebox+        stateChan+        (\snapshot -> postGUIASync $ runReaderT (renderSnapshot snapshot) ctx)+  _ <- lift $ Gtk.onWidgetButtonPressEvent ebox $ dispatchButtonEvent ctx backendType+  lift $ Gtk.widgetShowAll ebox+  Gtk.toWidget ebox --- | Call 'switch' with the appropriate argument (1 for left click, -1 for--- right click), depending on the click event received.-dispatchButtonEvent :: Context -> EventButton -> IO Bool-dispatchButtonEvent context btn = do+autoLayoutStateSource :: TaffyIO (TChan LayoutSnapshot, MV.MVar LayoutSnapshot)+autoLayoutStateSource = do+  backendType <- asks backend+  case backendType of+    BackendWayland -> getHyprlandLayoutStateChanAndVar+    BackendX11 -> getEWMHLayoutStateChanAndVar++dispatchButtonEvent :: Context -> Backend -> EventButton -> IO Bool+dispatchButtonEvent context backendType btn = do   pressType <- getEventButtonType btn   buttonNumber <- getEventButtonButton btn   case pressType of-    EventTypeButtonPress ->-      case buttonNumber of-        1 -> runReaderT (runX11Def () (switch 1)) context >> return True-        2 -> runReaderT (runX11Def () (switch (-1))) context >> return True-        _ -> return False+    EventTypeButtonPress -> case backendType of+      BackendWayland -> return False+      BackendX11 ->+        case buttonNumber of+          1 -> runReaderT (runX11Def () (switchEWMHLayoutBy 1)) context >> return True+          2 -> runReaderT (runX11Def () (switchEWMHLayoutBy (-1))) context >> return True+          _ -> return False     _ -> return False---- | Emit a new custom event of type _XMONAD_CURRENT_LAYOUT, that can be--- intercepted by the PagerHints hook, which in turn can instruct XMonad to--- switch to a different layout.-switch :: Int -> X11Property ()-switch n = do-  cmd <- getAtom xLayoutProp-  sendCommandEvent cmd (fromIntegral n)

@@ -118,6 +118,7 @@ -- | Configuration for 'simplePlayerWidget'. data SimpleMPRIS2PlayerConfig = SimpleMPRIS2PlayerConfig   { setNowPlayingLabel :: NowPlaying -> IO T.Text,+    setupPlayerLabel :: Gtk.Label -> IO (),     showPlayerWidgetFn :: NowPlaying -> IO Bool   } @@ -126,6 +127,7 @@ defaultPlayerConfig =   SimpleMPRIS2PlayerConfig     { setNowPlayingLabel = playingText 20 30,+      setupPlayerLabel = const (pure ()),       showPlayerWidgetFn =         \NowPlaying {npStatus = status} -> return $ status /= "Stopped"     }@@ -253,6 +255,7 @@       image <- autoSizeImageNew (loadIconAtSize client busName) Gtk.OrientationHorizontal       playerBox <- Gtk.gridNew       label <- Gtk.labelNew Nothing+      setupPlayerLabel c label       ebox <- Gtk.eventBoxNew       _ <-         Gtk.onWidgetButtonPressEvent ebox $@@ -320,6 +323,7 @@       clickArea <- Gtk.boxNew Gtk.OrientationHorizontal 0       controlsBox <- Gtk.boxNew Gtk.OrientationHorizontal 0       label <- Gtk.labelNew Nothing+      setupPlayerLabel c label       nowPlayingVar <- MV.newMVar nowPlaying       (previousButton, _) <- newControlButton backIconText       (playPauseButton, playPauseButtonLabel) <- newControlButton toggleIconText@@ -445,12 +449,6 @@             updatedWidgets <- M.fromList <$> mapM updateWidgetFromNP nowPlayings             return $ M.union updatedWidgets playerWidgets -          updatePlayerWidgetsVar nowPlayings =-            postGUISync $-              MV.modifyMVar_ playerWidgetsVar $-                flip runReaderT ctx-                  . updatePlayerWidgets nowPlayings-           setPlayingClass = do             anyVisible <- anyM Gtk.widgetIsVisible =<< Gtk.containerGetChildren grid             if anyVisible@@ -463,8 +461,11 @@            doUpdate = do             nowPlayings <- getNowPlayingInfo client-            updatePlayerWidgetsVar nowPlayings-            setPlayingClass+            postGUISync $ do+              MV.modifyMVar_ playerWidgetsVar $+                flip runReaderT ctx+                  . updatePlayerWidgets nowPlayings+              setPlayingClass            signalCallback _ _ _ _ = doUpdate 

@@ -35,7 +35,7 @@   ) where -import Control.Monad (void)+import Control.Monad (forM_, void, when) import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Data.IORef@@ -183,7 +183,10 @@       buildTray         host         client-        sniTrayTrayParams {trayPriorityConfig = sniTrayPriorityConfig}+        sniTrayTrayParams+          { trayPriorityConfig = sniTrayPriorityConfig,+            trayShowNewIconsImmediately = False+          }     _ <- widgetSetClassGI tray "sni-tray"     outer <- Gtk.boxNew (trayOrientation sniTrayTrayParams) 0     _ <- widgetSetClassGI outer "sni-tray-collapsible"@@ -224,9 +227,7 @@               visibleCount                 | shouldLimit && not expanded = max 0 collapsedVisibleCount                 | otherwise = length children-              visibleChildren = take visibleCount children-              hiddenChildren = drop visibleCount children-              hiddenCount = length hiddenChildren+              hiddenCount = max 0 (length children - visibleCount)               showIndicator                 | expanded =                     shouldLimit@@ -236,8 +237,13 @@               indicatorText =                 collapsibleSNITrayIndicatorLabel hiddenCount expanded -          mapM_ Gtk.widgetShow visibleChildren-          mapM_ Gtk.widgetHide hiddenChildren+          forM_ (zip [0 :: Int ..] children) $ \(childIndex, child) -> do+            let shouldShow = childIndex < visibleCount+            isVisible <- Gtk.widgetGetVisible child+            when (isVisible /= shouldShow) $+              if shouldShow+                then Gtk.widgetShow child+                else Gtk.widgetHide child            if showIndicator             then do@@ -274,7 +280,7 @@      let queueRefresh _ _ =           void $-            Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT_IDLE $+            Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT $               void refresh >> return False     handlerId <- H.addUpdateHandler host queueRefresh     _ <- Gtk.onWidgetDestroy outer $ H.removeUpdateHandler host handlerId

@@ -19,7 +19,7 @@ where  import Control.Applicative ((<|>))-import Control.Monad (forM_, guard, join, void)+import Control.Monad (forM_, guard, void, when) import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import qualified DBus as D@@ -31,6 +31,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import Data.Char (isAlphaNum, isDigit, toLower)+import Data.Foldable (traverse_) import Data.IORef import Data.Int (Int32) import Data.List (isSuffixOf, nub, sortOn, stripPrefix)@@ -38,6 +39,7 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList) import Data.Ord (Down (..)) import qualified Data.Text as T+import Data.Unique (hashUnique) import Data.Word (Word32) import qualified Data.Yaml as Y import qualified GI.GLib as GLib@@ -50,6 +52,7 @@ import System.Directory (createDirectoryIfMissing, doesFileExist) import System.Environment.XDG.BaseDir (getUserConfigFile) import System.FilePath (isRelative, replaceExtension, takeBaseName, takeDirectory, takeExtension)+import System.Log.Logger (Priority (DEBUG, INFO), logM) import System.Taffybar.Context import System.Taffybar.Widget.SNITray   ( CollapsibleSNITrayParams (..),@@ -58,8 +61,12 @@     getTrayHost,   ) import System.Taffybar.Widget.Util+import Text.Printf import Text.Read (readMaybe) +prioritizedTrayLog :: Priority -> String -> IO ()+prioritizedTrayLog = logM "System.Taffybar.Widget.SNITray.PrioritizedCollapsible"+ type SNIPriorityMap = M.Map String Int  data SNIPriorityEntry = SNIPriorityEntry@@ -594,72 +601,123 @@   Gtk.widgetShowAll menu   Gtk.menuPopupAtPointer menu currentEvent -showPrioritySettingsMenu ::+showPriorityControlsMenu ::   Gtk.EventBox ->   Int ->   Int ->+  Bool ->+  (Bool -> T.Text) ->+  IORef Bool ->+  IORef Bool ->   IORef Int ->+  IORef Int ->   IORef (Maybe Int) ->   IO () ->+  IO () ->   IO ()-showPrioritySettingsMenu anchor priorityMin priorityMax maxVisibleRef thresholdRef onSettingsChanged = do-  currentEvent <- Gtk.getCurrentEvent-  currentMaxVisible <- readIORef maxVisibleRef-  currentThreshold <- readIORef thresholdRef+showPriorityControlsMenu+  anchor+  priorityMin+  priorityMax+  alwaysShowExpandControl+  priorityModeLabel+  expandedRef+  priorityEditModeRef+  hiddenCountRef+  maxVisibleRef+  thresholdRef+  onControlStateChanged+  onSettingsChanged = do+    currentEvent <- Gtk.getCurrentEvent+    currentExpanded <- readIORef expandedRef+    currentPriorityEditMode <- readIORef priorityEditModeRef+    currentHiddenCount <- readIORef hiddenCountRef+    currentMaxVisible <- readIORef maxVisibleRef+    currentThreshold <- readIORef thresholdRef -  menu <- Gtk.menuNew-  Gtk.menuAttachToWidget menu anchor Nothing+    menu <- Gtk.menuNew+    Gtk.menuAttachToWidget menu anchor Nothing -  maxVisibleItem <- Gtk.menuItemNewWithLabel ("Max visible (collapsed)" :: T.Text)-  maxVisibleMenu <- Gtk.menuNew-  Gtk.menuItemSetSubmenu maxVisibleItem (Just maxVisibleMenu)-  let maxVisibleOptions = [0 .. 20]-  forM_ maxVisibleOptions $ \option -> do-    let optionLabel =-          if option <= 0-            then "No limit" :: T.Text-            else T.pack (show option)-        prefix =-          if option == currentMaxVisible-            then "\x2713 " :: T.Text-            else "   "-    item <- Gtk.menuItemNewWithLabel (prefix <> optionLabel)-    void $ Gtk.onMenuItemActivate item $ do-      writeIORef maxVisibleRef option-      onSettingsChanged-    Gtk.menuShellAppend maxVisibleMenu item-  Gtk.menuShellAppend menu maxVisibleItem+    let showExpandControl =+          alwaysShowExpandControl || currentExpanded || currentHiddenCount > 0+    when showExpandControl $ do+      let expandLabel =+            if currentExpanded+              then "Allow tray icon hiding" :: T.Text+              else "Show all tray icons"+      expandItem <- Gtk.menuItemNewWithLabel expandLabel+      void $ Gtk.onMenuItemActivate expandItem $ do+        modifyIORef' expandedRef not+        onControlStateChanged+      Gtk.menuShellAppend menu expandItem -  thresholdItem <- Gtk.menuItemNewWithLabel ("Priority threshold" :: T.Text)-  thresholdMenu <- Gtk.menuNew-  Gtk.menuItemSetSubmenu thresholdItem (Just thresholdMenu)-  let thresholdOptions = Nothing : map Just [priorityMin .. priorityMax]-  forM_ thresholdOptions $ \option -> do-    let optionLabel =-          case option of-            Nothing -> "No threshold" :: T.Text-            Just value -> ">= " <> T.pack (show value)-        prefix =-          if option == currentThreshold+    let priorityModePrefix =+          if currentPriorityEditMode             then "\x2713 " :: T.Text             else "   "-    item <- Gtk.menuItemNewWithLabel (prefix <> optionLabel)-    void $ Gtk.onMenuItemActivate item $ do-      writeIORef thresholdRef option-      onSettingsChanged-    Gtk.menuShellAppend thresholdMenu item-  Gtk.menuShellAppend menu thresholdItem+        priorityModeItemLabel =+          priorityModePrefix+            <> "Priority edit mode: "+            <> priorityModeLabel currentPriorityEditMode+    priorityModeItem <- Gtk.menuItemNewWithLabel priorityModeItemLabel+    void $ Gtk.onMenuItemActivate priorityModeItem $ do+      modifyIORef' priorityEditModeRef not+      onControlStateChanged+    Gtk.menuShellAppend menu priorityModeItem -  void $-    Gtk.onWidgetHide menu $-      void $-        GLib.idleAdd GLib.PRIORITY_LOW $ do-          Gtk.widgetDestroy menu-          return False+    controlsSep <- Gtk.separatorMenuItemNew+    Gtk.menuShellAppend menu controlsSep -  Gtk.widgetShowAll menu-  Gtk.menuPopupAtPointer menu currentEvent+    maxVisibleItem <- Gtk.menuItemNewWithLabel ("Max visible (collapsed)" :: T.Text)+    maxVisibleMenu <- Gtk.menuNew+    Gtk.menuItemSetSubmenu maxVisibleItem (Just maxVisibleMenu)+    let maxVisibleOptions = [0 .. 20]+    forM_ maxVisibleOptions $ \option -> do+      let optionLabel =+            if option <= 0+              then "No limit" :: T.Text+              else T.pack (show option)+          prefix =+            if option == currentMaxVisible+              then "\x2713 " :: T.Text+              else "   "+      item <- Gtk.menuItemNewWithLabel (prefix <> optionLabel)+      void $ Gtk.onMenuItemActivate item $ do+        writeIORef maxVisibleRef option+        onSettingsChanged+      Gtk.menuShellAppend maxVisibleMenu item+    Gtk.menuShellAppend menu maxVisibleItem +    thresholdItem <- Gtk.menuItemNewWithLabel ("Priority threshold" :: T.Text)+    thresholdMenu <- Gtk.menuNew+    Gtk.menuItemSetSubmenu thresholdItem (Just thresholdMenu)+    let thresholdOptions = Nothing : map Just [priorityMin .. priorityMax]+    forM_ thresholdOptions $ \option -> do+      let optionLabel =+            case option of+              Nothing -> "No threshold" :: T.Text+              Just value -> ">= " <> T.pack (show value)+          prefix =+            if option == currentThreshold+              then "\x2713 " :: T.Text+              else "   "+      item <- Gtk.menuItemNewWithLabel (prefix <> optionLabel)+      void $ Gtk.onMenuItemActivate item $ do+        writeIORef thresholdRef option+        onSettingsChanged+      Gtk.menuShellAppend thresholdMenu item+    Gtk.menuShellAppend menu thresholdItem++    void $+      Gtk.onWidgetHide menu $+        void $+          GLib.idleAdd GLib.PRIORITY_LOW $ do+            Gtk.widgetDestroy menu+            return False++    Gtk.widgetShowAll menu+    Gtk.menuPopupAtPointer menu currentEvent+ -- | Build a collapsible StatusNotifierItem tray with priority editing controls -- and persisted priority state. sniTrayPrioritizedCollapsibleNew :: TaffyIO Gtk.Widget@@ -713,11 +771,11 @@     priorityEditModeRef <- newIORef prioritizedCollapsibleSNITrayStartPriorityEditMode     maxVisibleIconsRef <- newIORef initialMaxVisibleIcons     visibilityThresholdRef <- newIORef initialVisibilityThreshold-    knownItemIdentitiesRef <- newIORef ([] :: [String])+    hiddenCountRef <- newIORef 0     orderedInfosRef <- newIORef ([] :: [H.ItemInfo])     processDisambiguationKeysRef <- newIORef (M.empty :: M.Map String String)     trayRef <- newIORef Nothing-    rebuildTrayRef <- newIORef (return ())+    updateHandlerRef <- newIORef Nothing      outer <- Gtk.boxNew trayOrientation' 0     _ <- widgetSetClassGI outer "sni-tray-collapsible"@@ -730,35 +788,20 @@     overflowCountLabel <- Gtk.labelNew Nothing     _ <- widgetSetClassGI overflowCountLabel "sni-tray-overflow-count-label" -    expandIcon <- Gtk.imageNewFromIconName (Just "pan-down-symbolic") menuIconSize-    expandToggle <- Gtk.eventBoxNew-    _ <- widgetSetClassGI expandToggle "sni-tray-expand-toggle"-    Gtk.containerAdd expandToggle expandIcon--    priorityModeIcon <- Gtk.imageNewFromIconName (Just "document-edit-symbolic") menuIconSize-    priorityModeToggle <- Gtk.eventBoxNew-    _ <- widgetSetClassGI priorityModeToggle "sni-tray-edit-toggle"-    Gtk.containerAdd priorityModeToggle priorityModeIcon-     settingsIcon <- Gtk.imageNewFromIconName (Just "emblem-system-symbolic") menuIconSize+    settingsContent <- Gtk.boxNew trayOrientation' 3+    _ <- widgetSetClassGI settingsContent "sni-tray-settings-toggle-content"+    Gtk.boxPackStart settingsContent settingsIcon False False 0+    Gtk.boxPackStart settingsContent overflowCountLabel False False 0     settingsToggle <- Gtk.eventBoxNew     _ <- widgetSetClassGI settingsToggle "sni-tray-settings-toggle"-    Gtk.containerAdd settingsToggle settingsIcon-    Gtk.widgetSetTooltipText settingsToggle (Just "Tray display settings")+    Gtk.containerAdd settingsToggle settingsContent+    Gtk.widgetSetTooltipText settingsToggle (Just "Tray controls")      Gtk.boxPackStart outer trayContainer False False 0-    Gtk.boxPackStart outer overflowCountLabel False False 0-    Gtk.boxPackStart outer expandToggle False False 0-    Gtk.boxPackStart outer priorityModeToggle False False 0     Gtk.boxPackStart outer settingsToggle False False 0 -    let queueRebuild = do-          rebuild <- readIORef rebuildTrayRef-          void $-            Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT_IDLE $-              rebuild >> return False--        persistCurrentState = do+    let persistCurrentState = do           priorities <- readIORef prioritiesRef           maxVisibleIcons <- readIORef maxVisibleIconsRef           visibilityThresholdOverride <- readIORef visibilityThresholdRef@@ -773,6 +816,57 @@         processKeyForInfoFromMap processKeyMap info =           M.lookup (itemStableIdentity info) processKeyMap +        updateOrderedInfos recomputeProcessKeys = do+          infoMap <- H.itemInfoMap host+          let infos = M.elems infoMap+          processKeyMap <-+            if recomputeProcessKeys+              then processDisambiguationKeysForItems client infos+              else readIORef processDisambiguationKeysRef+          when recomputeProcessKeys $+            writeIORef processDisambiguationKeysRef processKeyMap+          priorities <- readIORef prioritiesRef+          let orderedInfos =+                sortedInfosByPriority+                  highPriorityFirstInMatcherOrder+                  priorityMin+                  priorityMax+                  defaultPriority+                  priorities+                  (processKeyForInfoFromMap processKeyMap)+                  infos+          writeIORef orderedInfosRef orderedInfos+          return orderedInfos++        scheduleRefresh recomputeProcessKeys waitForExactChildCount updateType = do+          attemptsRef <- newIORef (0 :: Int)+          void $+            Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT $+              do+                orderedInfos <- updateOrderedInfos recomputeProcessKeys+                maybeTray <- readIORef trayRef+                case maybeTray of+                  Nothing -> return False+                  Just tray -> do+                    childCount <- length <$> Gtk.containerGetChildren tray+                    let expectedChildCount = length orderedInfos+                    attempts <- readIORef attemptsRef+                    if waitForExactChildCount && childCount /= expectedChildCount && attempts < 50+                      then do+                        when (attempts == 0 || attempts == 49) $+                          prioritizedTrayLog DEBUG $+                            printf+                              "Delaying prioritized tray refresh update=%s; attempt=%d childCount=%d expected=%d"+                              (show updateType)+                              attempts+                              childCount+                              expectedChildCount+                        writeIORef attemptsRef (attempts + 1)+                        return True+                      else do+                        void $ refreshTray tray+                        return False+         editPriorityForClick clickContext = do           let clickedInfo = trayClickItemInfo clickContext           priorities <- readIORef prioritiesRef@@ -783,7 +877,7 @@               updatePriority newPriority = do                 setExplicitPriorityForItem                   prioritiesRef-                  (\_ -> persistCurrentState >> queueRebuild)+                  (\_ -> persistCurrentState >> scheduleRefresh False False H.IconUpdated)                   maybeProcessKey                   clickedInfo                   (fmap clampPriority newPriority)@@ -797,104 +891,99 @@          refreshPriorityModeToggle = do           editing <- readIORef priorityEditModeRef-          let tooltipText =-                if editing-                  then "Disable icon priority edit mode"-                  else "Enable icon priority edit mode"-          Gtk.widgetSetTooltipText-            priorityModeToggle-            (Just tooltipText)           if editing-            then addClassIfMissing "sni-tray-edit-toggle-active" priorityModeToggle-            else removeClassIfPresent "sni-tray-edit-toggle-active" priorityModeToggle-          if editing             then do               addClassIfMissing "sni-tray-editing" outer             else do               removeClassIfPresent "sni-tray-editing" outer-          Gtk.widgetShowAll priorityModeToggle -        refresh = do-          maybeTray <- readIORef trayRef-          case maybeTray of-            Nothing -> return 0-            Just tray -> do-              children <- Gtk.containerGetChildren tray-              expanded <- readIORef expandedRef-              priorities <- readIORef prioritiesRef-              maxVisibleIcons <- readIORef maxVisibleIconsRef-              thresholdValue <- readIORef visibilityThresholdRef-              orderedInfos <- readIORef orderedInfosRef-              processKeyMap <- readIORef processDisambiguationKeysRef+        refreshTray tray = do+          expanded <- readIORef expandedRef+          priorities <- readIORef prioritiesRef+          maxVisibleIcons <- readIORef maxVisibleIconsRef+          thresholdValue <- readIORef visibilityThresholdRef+          orderedInfos <- readIORef orderedInfosRef+          processKeyMap <- readIORef processDisambiguationKeysRef+          reorderTrayChildrenByIdentities tray (map itemStableIdentity orderedInfos)+          children <- Gtk.containerGetChildren tray -              let itemPriority info =-                    itemPriorityFromMap-                      priorityMin-                      priorityMax-                      defaultPriority-                      priorities-                      (processKeyForInfoFromMap processKeyMap info)-                      info-                  totalCount = length children-                  collapsedThresholdVisibleCount =-                    case thresholdValue of-                      Nothing -> totalCount-                      Just threshold ->-                        min-                          totalCount-                          (length $ filter (\info -> itemPriority info >= threshold) orderedInfos)-                  collapsedVisibleCount-                    | maxVisibleIcons > 0 =-                        min collapsedThresholdVisibleCount maxVisibleIcons-                    | otherwise = collapsedThresholdVisibleCount-                  visibleCount-                    | expanded = totalCount-                    | otherwise = collapsedVisibleCount-                  visibleChildren = take visibleCount children-                  hiddenChildren = drop visibleCount children-                  hiddenCount = length hiddenChildren-                  showExpandToggle =-                    prioritizedCollapsibleSNITrayAlwaysShowExpandToggle-                      || ( if expanded-                             then collapsibleSNITrayShowIndicatorWhenExpanded && hiddenCount > 0-                             else hiddenCount > 0-                         )-                  expandIconName =-                    if expanded-                      then "pan-up-symbolic"-                      else "pan-down-symbolic"-                  expandTooltip =-                    if expanded-                      then "Allow tray icon hiding"-                      else "Show all tray icons"-                  hiddenCountText = T.pack (show hiddenCount)+          let itemPriority info =+                itemPriorityFromMap+                  priorityMin+                  priorityMax+                  defaultPriority+                  priorities+                  (processKeyForInfoFromMap processKeyMap info)+                  info+              totalCount = length children+              collapsedThresholdVisibleCount =+                case thresholdValue of+                  Nothing -> totalCount+                  Just threshold ->+                    min+                      totalCount+                      (length $ filter (\info -> itemPriority info >= threshold) orderedInfos)+              collapsedVisibleCount+                | maxVisibleIcons > 0 =+                    min collapsedThresholdVisibleCount maxVisibleIcons+                | otherwise = collapsedThresholdVisibleCount+              visibleCount+                | expanded = totalCount+                | otherwise = collapsedVisibleCount+              hiddenCount = max 0 (totalCount - visibleCount)+              hiddenCountText = T.pack (show hiddenCount) -              mapM_ Gtk.widgetShow visibleChildren-              mapM_ Gtk.widgetHide hiddenChildren+          forM_ (zip [0 :: Int ..] children) $ \(childIndex, child) -> do+            let shouldShow = childIndex < visibleCount+            isVisible <- Gtk.widgetGetVisible child+            when (isVisible /= shouldShow) $+              if shouldShow+                then Gtk.widgetShow child+                else Gtk.widgetHide child+          writeIORef hiddenCountRef hiddenCount -              Gtk.imageSetFromIconName expandIcon (Just expandIconName) menuIconSize-              if showExpandToggle-                then do-                  Gtk.widgetSetTooltipText expandToggle (Just expandTooltip)-                  Gtk.widgetShowAll expandToggle-                else do-                  Gtk.widgetSetTooltipText expandToggle Nothing-                  Gtk.widgetHide expandToggle+          if hiddenCount > 0+            then do+              Gtk.labelSetText overflowCountLabel hiddenCountText+              Gtk.widgetShow overflowCountLabel+            else do+              Gtk.labelSetText overflowCountLabel ""+              Gtk.widgetHide overflowCountLabel -              if hiddenCount > 0-                then do-                  Gtk.labelSetText overflowCountLabel hiddenCountText-                  Gtk.widgetShow overflowCountLabel-                else do-                  Gtk.labelSetText overflowCountLabel ""-                  Gtk.widgetHide overflowCountLabel+          if expanded+            then addClassIfMissing "sni-tray-collapsible-expanded" outer+            else removeClassIfPresent "sni-tray-collapsible-expanded" outer -              if expanded-                then addClassIfMissing "sni-tray-collapsible-expanded" outer-                else removeClassIfPresent "sni-tray-collapsible-expanded" outer+          return hiddenCount -              return hiddenCount+        refresh = do+          maybeTray <- readIORef trayRef+          case maybeTray of+            Nothing -> return 0+            Just tray -> refreshTray tray +        queueRefresh updateType _ =+          case updateType of+            H.ItemAdded -> scheduleRefresh True True updateType+            H.ItemRemoved -> scheduleRefresh True True updateType+            _ -> scheduleRefresh False False updateType++        installUpdateHandler = do+          maybeHandlerId <- readIORef updateHandlerRef+          case maybeHandlerId of+            Just handlerId ->+              prioritizedTrayLog DEBUG $+                printf+                  "installUpdateHandler: handler already registered id=%d"+                  (hashUnique handlerId)+            Nothing -> do+              handlerId <- H.addUpdateHandler host queueRefresh+              prioritizedTrayLog INFO $+                printf+                  "Registered prioritized tray host update handler id=%d"+                  (hashUnique handlerId)+              writeIORef updateHandlerRef (Just handlerId)+         buildTrayWithPriorities priorities processKeyMap infos = do           let priorityConfig =                 sniTrayPriorityConfig@@ -922,109 +1011,56 @@               trayParams =                 sniTrayTrayParams                   { trayEventHooks =-                      baseHooks {trayClickHook = Just combinedClickHook}+                      baseHooks {trayClickHook = Just combinedClickHook},+                    trayShowNewIconsImmediately = False                   }           tray <- buildTray host client trayParams {trayPriorityConfig = priorityConfig}           _ <- widgetSetClassGI tray "sni-tray"           return tray -        rebuildTray = do-          priorities <- readIORef prioritiesRef-          infoMap <- H.itemInfoMap host-          processKeyMap <- processDisambiguationKeysForItems client (M.elems infoMap)-          let infos = M.elems infoMap-              orderedInfos =-                sortedInfosByPriority-                  highPriorityFirstInMatcherOrder-                  priorityMin-                  priorityMax-                  defaultPriority-                  priorities-                  (processKeyForInfoFromMap processKeyMap)-                  infos-              currentItemIdentities =-                sortOn id (map itemStableIdentity infos)-          tray <- buildTrayWithPriorities priorities processKeyMap orderedInfos-          Gtk.widgetHide tray-          oldTray <- readIORef trayRef-          forM_ oldTray $ \existingTray -> do-            Gtk.containerRemove trayContainer existingTray-            Gtk.widgetDestroy existingTray-          Gtk.boxPackStart trayContainer tray False False 0-          writeIORef trayRef (Just tray)-          writeIORef orderedInfosRef orderedInfos-          writeIORef processDisambiguationKeysRef processKeyMap-          writeIORef knownItemIdentitiesRef currentItemIdentities-          void refresh-          Gtk.widgetShow tray--    writeIORef rebuildTrayRef rebuildTray--    _ <- Gtk.onWidgetButtonPressEvent expandToggle $ \event -> do-      eventType <- Gdk.getEventButtonType event-      button <- Gdk.getEventButtonButton event-      if eventType == Gdk.EventTypeButtonPress && button == 1-        then do-          modifyIORef' expandedRef not-          void refresh-          return True-        else return False--    _ <- Gtk.onWidgetButtonPressEvent priorityModeToggle $ \event -> do-      eventType <- Gdk.getEventButtonType event-      button <- Gdk.getEventButtonButton event-      if eventType == Gdk.EventTypeButtonPress && button == 1-        then do-          modifyIORef' priorityEditModeRef not-          refreshPriorityModeToggle-          return True-        else return False-     _ <- Gtk.onWidgetButtonPressEvent settingsToggle $ \event -> do       eventType <- Gdk.getEventButtonType event       button <- Gdk.getEventButtonButton event       if eventType == Gdk.EventTypeButtonPress && button == 1         then do-          showPrioritySettingsMenu+          showPriorityControlsMenu             settingsToggle             priorityMin             priorityMax+            prioritizedCollapsibleSNITrayAlwaysShowExpandToggle+            prioritizedCollapsibleSNITrayPriorityModeLabel+            expandedRef+            priorityEditModeRef+            hiddenCountRef             maxVisibleIconsRef             visibilityThresholdRef-            (persistCurrentState >> void refresh)+            (refreshPriorityModeToggle >> void refresh)+            (persistCurrentState >> scheduleRefresh False False H.ToolTipUpdated)           return True         else return False -    let queueRefresh updateType _ =-          void $-            Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT_IDLE $-              do-                case updateType of-                  H.ItemAdded -> do-                    infoMap <- H.itemInfoMap host-                    knownItemIdentities <- readIORef knownItemIdentitiesRef-                    let currentItemIdentities =-                          sortOn id (map itemStableIdentity (M.elems infoMap))-                    if currentItemIdentities /= knownItemIdentities-                      then do-                        join (readIORef rebuildTrayRef)-                      else void refresh-                  H.ItemRemoved -> do-                    infoMap <- H.itemInfoMap host-                    knownItemIdentities <- readIORef knownItemIdentitiesRef-                    let currentItemIdentities =-                          sortOn id (map itemStableIdentity (M.elems infoMap))-                    if currentItemIdentities /= knownItemIdentities-                      then do-                        join (readIORef rebuildTrayRef)-                      else void refresh-                  _ -> void refresh-                return False-    handlerId <- H.addUpdateHandler host queueRefresh-    _ <- Gtk.onWidgetDestroy outer $ H.removeUpdateHandler host handlerId+    _ <-+      Gtk.onWidgetDestroy outer $+        readIORef updateHandlerRef+          >>= traverse_+            ( \handlerId -> do+                prioritizedTrayLog INFO $+                  printf+                    "Removing prioritized tray host update handler id=%d"+                    (hashUnique handlerId)+                H.removeUpdateHandler host handlerId+            ) -    rebuildTray+    orderedInfos <- updateOrderedInfos True+    priorities <- readIORef prioritiesRef+    processKeyMap <- readIORef processDisambiguationKeysRef+    tray <- buildTrayWithPriorities priorities processKeyMap orderedInfos+    Gtk.boxPackStart trayContainer tray False False 0+    writeIORef trayRef (Just tray)+    installUpdateHandler+    Gtk.widgetShow tray++    Gtk.widgetShowAll outer     refreshPriorityModeToggle     _ <- refresh-    Gtk.widgetShowAll outer     return outerWidget

@@ -4,9 +4,10 @@ module System.Taffybar.Widget.Text.CPUMonitor (textCpuMonitorNew) where  import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T import qualified GI.Gtk+import System.Taffybar.Context (TaffyIO) import System.Taffybar.Information.CPU2 (CPULoad (..), getCPULoadChan) import System.Taffybar.Util (postGUIASync) import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew)@@ -17,23 +18,23 @@ -- | Creates a simple textual CPU monitor. It updates once every polling -- period (in seconds). textCpuMonitorNew ::-  (MonadIO m) =>   -- | Format. You can use variables: $total$, $user$, $system$   String ->   -- | Polling period (in seconds)   Double ->-  m GI.Gtk.Widget-textCpuMonitorNew fmt period = liftIO $ do+  TaffyIO GI.Gtk.Widget+textCpuMonitorNew fmt period = do   chan <- getCPULoadChan "cpu" period-  label <- GI.Gtk.labelNew Nothing-  _ <- widgetSetClassGI label (T.pack "text-cpu-monitor")-  void $-    channelWidgetNew label chan $ \sample ->-      postGUIASync $-        GI.Gtk.labelSetMarkup label $-          renderCpuInfo fmt sample-  widget <- GI.Gtk.toWidget label-  widgetSetClassGI widget (T.pack "text-cpu-monitor")+  liftIO $ do+    label <- GI.Gtk.labelNew Nothing+    _ <- widgetSetClassGI label (T.pack "text-cpu-monitor")+    void $+      channelWidgetNew label chan $ \sample ->+        postGUIASync $+          GI.Gtk.labelSetMarkup label $+            renderCpuInfo fmt sample+    widget <- GI.Gtk.toWidget label+    widgetSetClassGI widget (T.pack "text-cpu-monitor")  renderCpuInfo :: String -> CPULoad -> T.Text renderCpuInfo fmt CPULoad {cpuUserLoad, cpuSystemLoad, cpuTotalLoad} =

@@ -33,8 +33,8 @@ import qualified GI.GdkPixbuf.Objects.Pixbuf as GI import qualified GI.GdkPixbuf.Objects.Pixbuf as PB import GI.Gtk as Gtk+import Graphics.UI.GIGtkScalingImage (scalePixbufToSize) import Paths_taffybar (getDataDir)-import StatusNotifier.Tray (scalePixbufToSize) import System.Environment.XDG.DesktopEntry import System.FilePath.Posix import System.Log.Logger (Priority (..))

@@ -47,15 +47,15 @@   ( getHyprlandWorkspaceStateChanAndVar,   ) import System.Taffybar.Information.Workspaces.Model-import System.Taffybar.Util-import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew)-import System.Taffybar.Widget.Generic.ScalingImage (scalingImage)-import System.Taffybar.Widget.Util (widgetSetClassGI)-import System.Taffybar.Widget.Workspaces+import System.Taffybar.Information.Workspaces.Support   ( defaultOnWindowClick,     getWindowIconPixbufByClassHints,     sortWindowsByPosition,   )+import System.Taffybar.Util+import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew)+import System.Taffybar.Widget.Generic.ScalingImage (scalingImage)+import System.Taffybar.Widget.Util (widgetSetClassGI)  -- | Behavior configuration for the windows menu widget. data WindowsConfig = WindowsConfig@@ -63,6 +63,8 @@     getMenuLabel :: WindowInfo -> TaffyIO T.Text,     -- | Action to build the label text for the active window.     getActiveLabel :: Maybe WindowInfo -> TaffyIO T.Text,+    -- | Customize the active-window label widget after creation.+    configureActiveLabel :: Gtk.Label -> TaffyIO (),     -- | Optional function to retrieve a pixbuf to show next to the     -- active-window label.     getActiveWindowIconPixbuf :: Maybe (Int32 -> WindowInfo -> TaffyIO (Maybe Gdk.Pixbuf)),@@ -114,6 +116,7 @@   WindowsConfig     { getMenuLabel = defaultGetMenuLabel,       getActiveLabel = defaultGetActiveLabel,+      configureActiveLabel = const (pure ()),       getActiveWindowIconPixbuf = Just getWindowIconPixbufByClassHints,       menuWindowSort = pure . sortWindowsByPosition,       onMenuWindowClick = defaultOnWindowClick@@ -142,7 +145,7 @@       pure rf     Nothing -> pure (pure ()) -  (setLabelTitle, label) <- buildWindowsLabel+  (setLabelTitle, label) <- buildWindowsLabel config   Gtk.boxPackStart hbox label True True 0    let refreshFromSnapshot snapshot = do@@ -179,11 +182,12 @@   widgetSetClassGI menuButtonWidget "windows"  -- | Build the active-window label and return an update action for it.-buildWindowsLabel :: TaffyIO (T.Text -> IO (), Gtk.Widget)-buildWindowsLabel = do+buildWindowsLabel :: WindowsConfig -> TaffyIO (T.Text -> IO (), Gtk.Widget)+buildWindowsLabel config = do   label <- lift $ Gtk.labelNew Nothing   lift $ Gtk.labelSetSingleLineMode label True   lift $ Gtk.labelSetEllipsize label Pango.EllipsizeModeEnd+  configureActiveLabel config label   let setLabelTitle title = postGUIASync $ Gtk.labelSetText label title   (setLabelTitle,) <$> Gtk.toWidget label 

@@ -47,33 +47,25 @@  import qualified Control.Concurrent.MVar as MV import Control.Concurrent.STM.TChan (TChan)-import Control.Exception.Enclosed (catchAny) import Control.Monad (foldM, forM_, guard, when)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Reader (ask, asks, runReaderT) import Data.Default (Default (..)) import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.Int (Int32)-import Data.List (elemIndex, sortBy, sortOn)+import Data.List (elemIndex) import qualified Data.Map.Strict as M-import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Word (Word64) import qualified GI.Gdk.Enums as Gdk import qualified GI.Gdk.Structs.EventScroll as Gdk import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk import qualified GI.Gtk as Gtk+import Data.Int (Int32) import System.Log.Logger (Priority (..), logM)-import System.Taffybar.Context (Backend (..), TaffyIO, backend, runX11Def)-import System.Taffybar.Hyprland (getHyprlandClient)+import System.Taffybar.Context (Backend (..), TaffyIO, backend) import System.Taffybar.Information.EWMHDesktopInfo-  ( WorkspaceId (WorkspaceId),-    ewmhWMIcon,-    focusWindow,-    getWindowsStacking,-    switchToWorkspace,+  ( ewmhWMIcon,   )-import qualified System.Taffybar.Information.Hyprland.API as HyprAPI import System.Taffybar.Information.Workspaces.EWMH   ( EWMHWorkspaceProviderConfig,     defaultEWMHWorkspaceProviderConfig,@@ -84,35 +76,51 @@   ( getHyprlandWorkspaceStateChanAndVar,   ) import System.Taffybar.Information.Workspaces.Model-import System.Taffybar.Util (getPixbufFromFilePath, postGUIASync, (<|||>))+import System.Taffybar.Information.Workspaces.Support+  ( WindowIconPixbufGetter,+    addCustomIconsAndFallback,+    addCustomIconsToDefaultWithFallbackByPath,+    constantScaleWindowIconPixbufGetter,+    defaultGetWindowIconPixbuf,+    defaultOnWindowClick,+    defaultOnWorkspaceClick,+    defaultOnWorkspaceClickEWMH,+    getWindowIconPixbufByClassHints,+    getWindowIconPixbufFromChrome,+    getWindowIconPixbufFromClass,+    getWindowIconPixbufFromClassHints,+    getWindowIconPixbufFromDesktopEntry,+    getWindowIconPixbufFromEWMH,+    handleIconGetterException,+    scaledWindowIconPixbufGetter,+    sortWindowsByPosition,+    sortWindowsByStackIndex,+    unscaledDefaultGetWindowIconPixbuf,+  )+import System.Taffybar.Util (postGUIASync)+import System.Taffybar.Widget.Generic.AutoSizeImage (ImageScaleStrategy) import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew)-import System.Taffybar.Widget.Generic.ScalingImage (getScalingImageStrategy)+import System.Taffybar.Widget.Generic.ScalingImage+  ( getScalingImageStrategy,+    scalingImageNew,+  ) import System.Taffybar.Widget.Util   ( WindowIconWidget (..),+    buildBottomLeftAlignedBox,+    buildContentsBox,+    buildOverlayWithPassThrough,     computeIconStripLayout,-    handlePixbufGetterException,-    scaledPixbufGetter,+    mkWindowIconWidgetBase,     syncWidgetPool,+    updateWidgetClasses,     updateWindowIconWidgetState,     widgetSetClassGI,     windowStatusClassFromFlags,   )-import System.Taffybar.Widget.Workspaces.Shared-  ( WorkspaceState (..),-    buildWorkspaceIconLabelOverlay,-    mkWorkspaceIconWidget,-    setWorkspaceWidgetStatusClass,-  ) import System.Taffybar.WindowIcon-  ( getCachedIconPixBufFromEWMH,-    getCachedWindowIconFromClasses,-    getCachedWindowIconFromDesktopEntryByClasses,-    getPixBufFromChromeData,-    pixBufFromColor,+  ( pixBufFromColor,   ) -type WindowIconPixbufGetter = Int32 -> WindowInfo -> TaffyIO (Maybe Gdk.Pixbuf)- data WorkspaceWidgetController = WorkspaceWidgetController   { controllerWidget :: Gtk.Widget,     controllerUpdate :: WorkspaceInfo -> TaffyIO (),@@ -137,6 +145,76 @@     onWindowClick :: WindowInfo -> TaffyIO ()   } +data WorkspaceState+  = Active+  | Visible+  | Hidden+  | Empty+  | Urgent+  deriving (Show, Eq)++getCSSClass :: (Show s) => s -> T.Text+getCSSClass = T.toLower . T.pack . show++cssWorkspaceStates :: [T.Text]+cssWorkspaceStates = map getCSSClass [Active, Visible, Hidden, Empty, Urgent]++setWorkspaceWidgetStatusClass ::+  (MonadIO m, Gtk.IsWidget a) => WorkspaceState -> a -> m ()+setWorkspaceWidgetStatusClass ws widget =+  updateWidgetClasses+    widget+    [getCSSClass ws]+    cssWorkspaceStates++-- | Build the common overlay layout used by workspace widgets:+-- window icons are the base content and the workspace label is overlaid in the+-- bottom-left corner.+buildWorkspaceIconLabelOverlay ::+  (MonadIO m) =>+  Gtk.Widget ->+  Gtk.Widget ->+  m Gtk.Widget+buildWorkspaceIconLabelOverlay iconsWidget labelWidget = do+  base <- buildContentsBox iconsWidget+  overlayLabel <- buildBottomLeftAlignedBox "overlay-box" labelWidget+  buildOverlayWithPassThrough base [overlayLabel]++mkWorkspaceIconWidget ::+  ImageScaleStrategy ->+  Maybe Int32 ->+  Bool ->+  (Int32 -> a -> IO (Maybe Gdk.Pixbuf)) ->+  (Int32 -> IO Gdk.Pixbuf) ->+  IO (WindowIconWidget a)+mkWorkspaceIconWidget strategy mSize transparentOnNone getPixbufFor mkTransparent = do+  base <- mkWindowIconWidgetBase mSize+  let getPixbuf size = do+        mWin <- MV.readMVar (iconWindow base)+        case mWin of+          Nothing ->+            if transparentOnNone+              then Just <$> mkTransparent size+              else return Nothing+          Just w -> do+            pb <- getPixbufFor size w+            case pb of+              Just _ -> return pb+              Nothing ->+                if transparentOnNone+                  then Just <$> mkTransparent size+                  else return Nothing+  (imageWidget, refreshImage) <-+    scalingImageNew+      strategy+      getPixbuf+      Gtk.OrientationHorizontal+  _ <- widgetSetClassGI imageWidget "window-icon"+  forM_ mSize $ \s ->+    Gtk.widgetSetSizeRequest imageWidget (fromIntegral s) (fromIntegral s)+  Gtk.containerAdd (iconContainer base) imageWidget+  return base {iconImage = imageWidget, iconForceUpdate = refreshImage}+ data WorkspaceEntry = WorkspaceEntry   { entryWrapper :: Gtk.Widget,     entryButton :: Gtk.EventBox,@@ -208,8 +286,8 @@         labelText <- labelSetter cfg newWs         let wsState = toCSSState cfg newWs         liftIO $ Gtk.labelSetMarkup label (T.pack labelText)-        liftIO $ setWorkspaceWidgetStatusClass wsState contents-        liftIO $ setWorkspaceWidgetStatusClass wsState label+        setWorkspaceWidgetStatusClass wsState contents+        setWorkspaceWidgetStatusClass wsState label         currentIcons <- liftIO $ readIORef iconsRef         let needsIconUpdate =               forceIcons@@ -236,168 +314,6 @@ hideEmpty :: WorkspaceInfo -> Bool hideEmpty WorkspaceInfo {workspaceState = WorkspaceEmpty} = False hideEmpty _ = True--sortWindowsByPosition :: [WindowInfo] -> [WindowInfo]-sortWindowsByPosition =-  sortOn $ \w ->-    ( windowMinimized w,-      fromMaybe (999999999, 999999999) (windowPosition w)-    )--sortWindowsByStackIndex :: [WindowInfo] -> TaffyIO [WindowInfo]-sortWindowsByStackIndex wins = do-  stackingWindows <- runX11Def [] getWindowsStacking-  let getStackIdx windowInfo =-        case windowIdentity windowInfo of-          X11WindowIdentity wid -> fromMaybe (-1) $ elemIndex (fromIntegral wid) stackingWindows-          HyprlandWindowIdentity _ -> -1-      compareWindowData a b = compare (getStackIdx b) (getStackIdx a)-  return $ sortBy compareWindowData wins--scaledWindowIconPixbufGetter :: WindowIconPixbufGetter -> WindowIconPixbufGetter-scaledWindowIconPixbufGetter = scaledPixbufGetter--constantScaleWindowIconPixbufGetter ::-  Int32 -> WindowIconPixbufGetter -> WindowIconPixbufGetter-constantScaleWindowIconPixbufGetter constantSize getter =-  const $ scaledWindowIconPixbufGetter getter constantSize--handleIconGetterException :: WindowIconPixbufGetter -> WindowIconPixbufGetter-handleIconGetterException = handlePixbufGetterException wLog--getWindowIconPixbufFromClassHints :: WindowIconPixbufGetter-getWindowIconPixbufFromClassHints =-  getWindowIconPixbufFromDesktopEntry <|||> getWindowIconPixbufFromClass--getWindowIconPixbufFromDesktopEntry :: WindowIconPixbufGetter-getWindowIconPixbufFromDesktopEntry = handleIconGetterException $ \size winInfo ->-  tryHints size (map T.unpack (windowClassHints winInfo))-  where-    tryHints _ [] = return Nothing-    tryHints requestedSize (klass : rest) = do-      fromDesktopEntry <- getCachedWindowIconFromDesktopEntryByClasses requestedSize klass-      case fromDesktopEntry of-        Just _ -> return fromDesktopEntry-        Nothing -> tryHints requestedSize rest--getWindowIconPixbufFromClass :: WindowIconPixbufGetter-getWindowIconPixbufFromClass = handleIconGetterException $ \size winInfo ->-  tryHints size (map T.unpack (windowClassHints winInfo))-  where-    tryHints _ [] = return Nothing-    tryHints requestedSize (klass : rest) = do-      fromClass <- getCachedWindowIconFromClasses requestedSize klass-      case fromClass of-        Just _ -> return fromClass-        Nothing -> tryHints requestedSize rest--getWindowIconPixbufByClassHints :: Int32 -> WindowInfo -> TaffyIO (Maybe Gdk.Pixbuf)-getWindowIconPixbufByClassHints = getWindowIconPixbufFromClassHints--getWindowIconPixbufFromChrome :: WindowIconPixbufGetter-getWindowIconPixbufFromChrome _ windowData =-  case windowIdentity windowData of-    X11WindowIdentity wid -> getPixBufFromChromeData (fromIntegral wid)-    HyprlandWindowIdentity _ -> return Nothing--getWindowIconPixbufFromEWMH :: WindowIconPixbufGetter-getWindowIconPixbufFromEWMH = handleIconGetterException $ \size windowData ->-  case windowIdentity windowData of-    X11WindowIdentity wid -> getCachedIconPixBufFromEWMH size (fromIntegral wid)-    HyprlandWindowIdentity _ -> return Nothing--defaultGetWindowIconPixbuf :: WindowIconPixbufGetter-defaultGetWindowIconPixbuf =-  scaledWindowIconPixbufGetter unscaledDefaultGetWindowIconPixbuf--unscaledDefaultGetWindowIconPixbuf :: WindowIconPixbufGetter-unscaledDefaultGetWindowIconPixbuf =-  getWindowIconPixbufFromDesktopEntry-    <|||> getWindowIconPixbufFromClass-    <|||> getWindowIconPixbufFromEWMH--addCustomIconsToDefaultWithFallbackByPath ::-  (WindowInfo -> Maybe FilePath) ->-  FilePath ->-  WindowIconPixbufGetter-addCustomIconsToDefaultWithFallbackByPath getCustomIconPath fallbackPath =-  addCustomIconsAndFallback-    getCustomIconPath-    (const $ liftIO $ getPixbufFromFilePath fallbackPath)-    unscaledDefaultGetWindowIconPixbuf--addCustomIconsAndFallback ::-  (WindowInfo -> Maybe FilePath) ->-  (Int32 -> TaffyIO (Maybe Gdk.Pixbuf)) ->-  WindowIconPixbufGetter ->-  WindowIconPixbufGetter-addCustomIconsAndFallback getCustomIconPath fallback defaultGetter =-  scaledWindowIconPixbufGetter $-    getCustomIcon <|||> defaultGetter <|||> (\s _ -> fallback s)-  where-    getCustomIcon :: WindowIconPixbufGetter-    getCustomIcon _ windowInfo =-      maybe (return Nothing) (liftIO . getPixbufFromFilePath) $-        getCustomIconPath windowInfo--defaultOnWorkspaceClick :: WorkspaceInfo -> TaffyIO ()-defaultOnWorkspaceClick wsInfo = do-  backendType <- asks backend-  case backendType of-    BackendX11 -> defaultOnWorkspaceClickEWMH wsInfo-    BackendWayland -> defaultOnWorkspaceClickHyprland wsInfo--defaultOnWorkspaceClickHyprland :: WorkspaceInfo -> TaffyIO ()-defaultOnWorkspaceClickHyprland wsInfo = do-  client <- getHyprlandClient-  let targetText = workspaceName (workspaceIdentity wsInfo)-  case HyprAPI.mkHyprlandWorkspaceTarget targetText of-    Left err ->-      wLog WARNING $-        "Failed to build Hyprland workspace target for " <> show targetText <> ": " <> show err-    Right target -> do-      result <- liftIO $ HyprAPI.dispatchHyprland client (HyprAPI.DispatchWorkspace target)-      case result of-        Left err ->-          wLog WARNING $-            "Failed to switch workspace via Hyprland dispatch: " <> show err-        Right _ -> return ()--defaultOnWorkspaceClickEWMH :: WorkspaceInfo -> TaffyIO ()-defaultOnWorkspaceClickEWMH wsInfo =-  case workspaceNumericId (workspaceIdentity wsInfo) of-    Nothing ->-      wLog WARNING $-        "Workspace has no numeric id for EWMH switch: " <> show (workspaceIdentity wsInfo)-    Just workspaceId ->-      runX11Def () (switchToWorkspace (WorkspaceId workspaceId))-        `catchAny` \err ->-          wLog WARNING $-            "Failed to switch EWMH workspace " <> show workspaceId <> ": " <> show err--defaultOnWindowClick :: WindowInfo -> TaffyIO ()-defaultOnWindowClick windowInfo =-  case windowIdentity windowInfo of-    X11WindowIdentity wid ->-      runX11Def () (focusWindow (fromIntegral wid))-        `catchAny` \err ->-          wLog WARNING $-            "Failed to focus X11 window " <> show wid <> ": " <> show err-    HyprlandWindowIdentity address -> do-      client <- getHyprlandClient-      case HyprAPI.mkHyprlandAddress address of-        Left err ->-          wLog WARNING $-            "Failed to build Hyprland window address " <> show address <> ": " <> show err-        Right addr -> do-          result <--            liftIO $-              HyprAPI.dispatchHyprland client (HyprAPI.DispatchFocusWindowAddress addr)-          case result of-            Left err ->-              wLog WARNING $-                "Failed to focus Hyprland window " <> show address <> ": " <> show err-            Right _ -> return ()  workspacesNew :: WorkspacesConfig -> TaffyIO Gtk.Widget workspacesNew cfg = do

@@ -1,123 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}------------------------------------------------------------------------------------------------------------------------------------------------------------------ |--- Module      : System.Taffybar.Widget.Workspaces.Shared--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable------ Shared UI helpers for workspace widgets (X11/EWMH and Hyprland).-module System.Taffybar.Widget.Workspaces.Shared-  ( WorkspaceState (..),-    getCSSClass,-    cssWorkspaceStates,-    setWorkspaceWidgetStatusClass,-    buildWorkspaceIconLabelOverlay,-    mkWorkspaceIconWidget,-  )-where--import qualified Control.Concurrent.MVar as MV-import Control.Monad-import Control.Monad.IO.Class (MonadIO (..))-import Data.Int (Int32)-import qualified Data.Text as T-import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk-import qualified GI.Gtk as Gtk-import System.Taffybar.Widget.Generic.AutoSizeImage (ImageScaleStrategy)-import System.Taffybar.Widget.Generic.ScalingImage (scalingImageNew)-import System.Taffybar.Widget.Util-  ( WindowIconWidget (..),-    buildBottomLeftAlignedBox,-    buildContentsBox,-    buildOverlayWithPassThrough,-    mkWindowIconWidgetBase,-    updateWidgetClasses,-    widgetSetClassGI,-  )--data WorkspaceState-  = Active-  | Visible-  | Hidden-  | Empty-  | Urgent-  deriving (Show, Eq)--getCSSClass :: (Show s) => s -> T.Text-getCSSClass = T.toLower . T.pack . show--cssWorkspaceStates :: [T.Text]-cssWorkspaceStates = map getCSSClass [Active, Visible, Hidden, Empty, Urgent]--setWorkspaceWidgetStatusClass ::-  (MonadIO m, Gtk.IsWidget a) => WorkspaceState -> a -> m ()-setWorkspaceWidgetStatusClass ws widget =-  updateWidgetClasses-    widget-    [getCSSClass ws]-    cssWorkspaceStates---- | Build the common overlay layout used by workspace widgets:--- window icons are the base content and the workspace label is overlaid in the--- bottom-left corner.-buildWorkspaceIconLabelOverlay ::-  (MonadIO m) =>-  -- | Widget containing the window icon strip.-  Gtk.Widget ->-  -- | Workspace label widget.-  Gtk.Widget ->-  m Gtk.Widget-buildWorkspaceIconLabelOverlay iconsWidget labelWidget = do-  base <- buildContentsBox iconsWidget-  overlayLabel <- buildBottomLeftAlignedBox "overlay-box" labelWidget-  buildOverlayWithPassThrough base [overlayLabel]---- | Build a 'WindowIconWidget' that automatically scales with allocation and--- displays a transparent placeholder pixbuf when requested.------ This is shared by both X11 and Hyprland workspace widgets so that CSS classes--- and widget behavior remain consistent across backends.-mkWorkspaceIconWidget ::-  -- | Which scaling implementation to use.-  ImageScaleStrategy ->-  -- | Optional size request for the icon image.-  Maybe Int32 ->-  -- | Whether to render a transparent placeholder when there is no data.-  Bool ->-  -- | Icon pixbuf getter.-  (Int32 -> a -> IO (Maybe Gdk.Pixbuf)) ->-  -- | Transparent placeholder pixbuf generator.-  (Int32 -> IO Gdk.Pixbuf) ->-  IO (WindowIconWidget a)-mkWorkspaceIconWidget strategy mSize transparentOnNone getPixbufFor mkTransparent = do-  base <- mkWindowIconWidgetBase mSize-  let getPixbuf size = do-        mWin <- MV.readMVar (iconWindow base)-        case mWin of-          Nothing ->-            if transparentOnNone-              then Just <$> mkTransparent size-              else return Nothing-          Just w -> do-            pb <- getPixbufFor size w-            case pb of-              Just _ -> return pb-              Nothing ->-                if transparentOnNone-                  then Just <$> mkTransparent size-                  else return Nothing-  (imageWidget, refreshImage) <--    scalingImageNew strategy getPixbuf Gtk.OrientationHorizontal-  _ <- widgetSetClassGI imageWidget "window-icon"-  forM_ mSize $ \s ->-    Gtk.widgetSetSizeRequest imageWidget (fromIntegral s) (fromIntegral s)-  Gtk.containerAdd (iconContainer base) imageWidget-  return base {iconImage = imageWidget, iconForceUpdate = refreshImage}

@@ -1,6 +1,6 @@ cabal-version: 3.4 name: taffybar-version: 6.0.0+version: 7.0.0 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD-3-Clause license-file: LICENSE@@ -9,7 +9,7 @@ category: System build-type: Simple tested-with: GHC == 9.8.4, GHC == 9.10.3, GHC == 9.12.3-homepage: http://github.com/taffybar/taffybar+homepage: https://github.com/taffybar/taffybar data-files:   taffybar.css   icons/*.svg@@ -67,7 +67,7 @@                , data-default                , dbus >= 1.2.11 && < 2.0.0                , dbus-hslogger >= 0.1.1.0 && < 0.2.0.0-               , dbus-menu >= 0.1.3.0+               , dbus-menu >= 0.1.3.2                , directory                , disk-free-space >= 0.1.0.1                , dyre >= 0.9.0 && < 0.10@@ -86,8 +86,9 @@                , gi-gtk3 >= 3.0.44 && < 4                , gi-gtk-hs >= 0.3.17 && < 0.4                , gi-pango-               , gtk-sni-tray >= 0.2.0.0-               , gtk-strut >= 0.1.2.1+               , gtk-scaling-image >= 0.1.0.0 && < 0.2+               , gtk-sni-tray >= 0.2.1.0+               , gtk-strut >= 0.1.4.0                , haskell-gi-base >= 0.24                , hslogger                , http-conduit@@ -103,7 +104,7 @@                , safe >= 0.3 && < 1                , scotty >= 0.20 && < 0.31                , split >= 0.1.4.2-               , status-notifier-item >= 0.3.2.6+               , status-notifier-item >= 0.3.2.11                , stm                , template-haskell                , text@@ -114,7 +115,7 @@                , tuple >= 0.3.0.2                , unix                , utf8-string-               , xdg-desktop-entry+               , xdg-desktop-entry >= 0.1.1.4                , xdg-basedir >= 0.2 && < 0.3                , xml                , xml-helpers@@ -140,7 +141,6 @@                  , System.Taffybar.Information.ASUS                  , System.Taffybar.Information.Battery                  , System.Taffybar.Information.Bluetooth-                 , System.Taffybar.Information.CPU                  , System.Taffybar.Information.CPU2                  , System.Taffybar.Information.Chrome                  , System.Taffybar.Information.Crypto@@ -149,6 +149,9 @@                  , System.Taffybar.Information.EWMHDesktopInfo                  , System.Taffybar.Information.Inhibitor                  , System.Taffybar.Information.KeyboardState+                 , System.Taffybar.Information.Layout.EWMH+                 , System.Taffybar.Information.Layout.Hyprland+                 , System.Taffybar.Information.Layout.Model                  , System.Taffybar.Information.MPRIS2                  , System.Taffybar.Information.Memory                  , System.Taffybar.Information.Network@@ -181,6 +184,7 @@                  , System.Taffybar.Widget.Bluetooth                  , System.Taffybar.Widget.CPUMonitor                  , System.Taffybar.Widget.CommandRunner+                 , System.Taffybar.Widget.CoordinatedClock                  , System.Taffybar.Widget.Crypto                  , System.Taffybar.Widget.DiskIOMonitor                  , System.Taffybar.Widget.DiskUsage@@ -224,7 +228,6 @@                  , System.Taffybar.Widget.Weather                  , System.Taffybar.Widget.Windows                  , System.Taffybar.Widget.Workspaces-                 , System.Taffybar.Widget.Workspaces.Shared                  , System.Taffybar.Widget.WirePlumber                  , System.Taffybar.Widget.Wlsunset                  , System.Taffybar.Widget.WttrIn@@ -251,6 +254,7 @@                , System.Taffybar.DBus.Client.Util                , System.Taffybar.Information.Hyprland.API                , System.Taffybar.Information.Hyprland.Types+               , System.Taffybar.Information.Workspaces.Support                , System.Taffybar.Information.Wakeup.Manager                , System.Taffybar.Information.Udev                , System.Taffybar.Window.FocusedMonitor@@ -369,6 +373,7 @@                , System.Taffybar.AppearanceSpec                , System.Taffybar.ContextSpec                , System.Taffybar.Information.CryptoSpec+               , System.Taffybar.Information.LayoutSpec                , System.Taffybar.Information.X11DesktopInfoSpec                , System.Taffybar.Information.WakeupSpec                , System.Taffybar.SimpleConfigSpec@@ -397,4 +402,4 @@  source-repository head   type: git-  location: http://github.com/taffybar/taffybar.git+  location: https://github.com/taffybar/taffybar.git

@@ -33,7 +33,7 @@   aroundAll withIntegrationEnv $ do     it "renders a bar under an EWMH window manager" $ \env -> do       goldenFile <- makeAbsolute "test/data/appearance-ewmh-bar.png"-      actualPng <- renderBarScreenshot env LegacyLayout+      actualPng <- renderBarScreenshot env SingleRowLayout       assertGolden "appearance" goldenFile actualPng      it "renders a two-level bar under an EWMH window manager" $ \env -> do@@ -42,7 +42,7 @@       assertGolden "appearance-levels" goldenFile actualPng      it "renders the workspaces widget under an EWMH window manager" $ \env -> do-      actualPng <- renderBarScreenshot env LegacyLayout+      actualPng <- renderBarScreenshot env SingleRowLayout       assertPngLooksRendered "ewmh-workspaces" actualPng      it "keeps configured bar height when the windows title has oversized glyph metrics" $ \env -> do@@ -55,7 +55,7 @@         actualPng <-           renderBarScreenshotWithArgs             env-            LegacyLayout+            SingleRowLayout             ["--expect-top-strut", "80"]         assertPngLooksRendered "ewmh-hidpi-strut" actualPng @@ -64,7 +64,7 @@     unless available $       pendingWith         "Hyprland integration environment unavailable (needs WAYLAND_DISPLAY, HYPRLAND_INSTANCE_SIGNATURE and grim)"-    actualPng <- renderHyprlandScreenshot LegacyLayout+    actualPng <- renderHyprlandScreenshot SingleRowLayout     assertPngLooksRendered "hyprland-workspaces" actualPng  assertGolden :: String -> FilePath -> BL.ByteString -> IO ()@@ -127,7 +127,7 @@               ]             $ action (Env {envTmpDir = tmp}) -data LayoutKind = LegacyLayout | LevelsLayout | WindowsTitleStressLayout+data LayoutKind = SingleRowLayout | LevelsLayout | WindowsTitleStressLayout  renderBarScreenshot :: Env -> LayoutKind -> IO BL.ByteString renderBarScreenshot env layout =@@ -146,7 +146,7 @@    let levelArgs =         case layout of-          LegacyLayout -> []+          SingleRowLayout -> []           LevelsLayout -> ["--levels"]           WindowsTitleStressLayout -> ["--windows-title-stress"]       pc =@@ -178,7 +178,7 @@     outPath <- makeAbsolute (tmp </> "appearance-hyprland-actual.png")     let levelArgs =           case layout of-            LegacyLayout -> []+            SingleRowLayout -> []             LevelsLayout -> ["--levels"]             WindowsTitleStressLayout -> []         pc =

@@ -0,0 +1,18 @@+module System.Taffybar.Information.LayoutSpec (spec) where++import Data.Text qualified as T+import System.Taffybar.Information.Layout.Hyprland+  ( isRelevantHyprlandLayoutEvent,+  )+import Test.Hspec++spec :: Spec+spec = describe "isRelevantHyprlandLayoutEvent" $ do+  it "accepts workspace and reconnect events" $ do+    isRelevantHyprlandLayoutEvent "workspace>>2" `shouldBe` True+    isRelevantHyprlandLayoutEvent "focusedmon>>HDMI-A-1,2" `shouldBe` True+    isRelevantHyprlandLayoutEvent "taffybar-hyprland-connected>>" `shouldBe` True++  it "ignores unrelated events" $ do+    isRelevantHyprlandLayoutEvent "activewindow>>kitty" `shouldBe` False+    isRelevantHyprlandLayoutEvent (T.pack "openwindow>>0x123") `shouldBe` False