taffybar 5.2.1 → 6.0.0

raw patch · 21 files changed

+61/−2657 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• app/DhallConfig.hs +22/−41
• src/System/Taffybar/Example.hs +6/−11
• src/System/Taffybar/Widget.hs +0/−69
• src/System/Taffybar/Widget/ChannelWorkspaces.hs +0/−42
• src/System/Taffybar/Widget/HyprlandWorkspaces.hs +0/−67
• src/System/Taffybar/Widget/Workspaces.hs +9/−5
• src/System/Taffybar/Widget/Workspaces/Channel.hs +0/−21
• src/System/Taffybar/Widget/Workspaces/Common.hs +0/−19
• src/System/Taffybar/Widget/Workspaces/Config.hs +0/−41
• src/System/Taffybar/Widget/Workspaces/EWMH.hs +0/−884
• src/System/Taffybar/Widget/Workspaces/EWMH/Compat.hs +0/−171
• src/System/Taffybar/Widget/Workspaces/Hyprland.hs +0/−963
• src/System/Taffybar/Widget/Workspaces/Hyprland/Compat.hs +0/−253
• src/System/Taffybar/Widget/Workspaces/X11.hs +0/−18
• src/System/Taffybar/WindowIcon.hs +8/−5
• taffybar.cabal +1/−12
• test/data/appearance-ewmh-bar-levels.png binary
• test/data/appearance-ewmh-bar.png binary
• test/data/appearance-hyprland-bar.png binary
• test/unit/System/Taffybar/Widget/HyprlandWorkspacesSpec.hs +0/−35

@@ -1,5 +1,20 @@ # Unreleased +# 6.0.0++## Breaking Changes++* Remove legacy workspace widget implementations.++## Fixes++* Fix workspace filter visibility after bar recreation.+* Fix window icon cache poisoning on failed lookups.++## Tests++* Refresh appearance golden images.+ # 5.2.1  ## Fixes

@@ -3,7 +3,6 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}  module DhallConfig   ( runDhallConfigFromFile,@@ -23,6 +22,7 @@ import System.Taffybar.DBus (withLogServer, withToggleServer) import System.Taffybar.Hooks (withBatteryRefresh, withLogLevels) import qualified System.Taffybar.Information.Wlsunset as WlsunsetInfo+import qualified System.Taffybar.Information.Workspaces.Model as WorkspaceModel import System.Taffybar.SimpleConfig import System.Taffybar.Widget import qualified System.Taffybar.Widget.Backlight as Backlight@@ -32,10 +32,6 @@ import qualified System.Taffybar.Widget.ScreenLock as ScreenLock import qualified System.Taffybar.Widget.Windows as Windows import qualified System.Taffybar.Widget.Wlsunset as Wlsunset-import qualified System.Taffybar.Widget.Workspaces.Config as WorkspaceConfig-import qualified System.Taffybar.Widget.Workspaces.EWMH as EWMHWorkspaces-import qualified System.Taffybar.Widget.Workspaces.Hyprland as HyprlandWorkspaces-import qualified System.Taffybar.Widget.Workspaces.Shared as WorkspaceShared  runDhallConfigFromFile :: FilePath -> IO () runDhallConfigFromFile path = do@@ -292,8 +288,8 @@   Backlight maybeBacklightSpec -> Backlight.backlightNewChanWith (backlightConfigFromSpec maybeBacklightSpec)   DiskUsage maybeDiskSpec -> DiskUsage.diskUsageNewWith (diskUsageConfigFromSpec maybeDiskSpec)   Windows maybeWindowsSpec -> Windows.windowsNew (windowsConfigFromSpec maybeWindowsSpec)-  WorkspacesEWMH maybeSpec -> EWMHWorkspaces.workspacesNew (ewmhConfigFromSpec maybeSpec)-  WorkspacesHyprland maybeSpec -> HyprlandWorkspaces.hyprlandWorkspacesNew (hyprlandConfigFromSpec maybeSpec)+  WorkspacesEWMH maybeSpec -> workspacesNew (ewmhConfigFromSpec maybeSpec)+  WorkspacesHyprland maybeSpec -> workspacesNew (hyprlandConfigFromSpec maybeSpec)   ScreenLock maybeSpec -> ScreenLock.screenLockNewWithConfig (screenLockConfigFromSpec maybeSpec)   Wlsunset maybeSpec -> Wlsunset.wlsunsetNewWithConfig (wlsunsetConfigFromSpec maybeSpec)   Layout -> layoutNew defaultLayoutConfig@@ -424,23 +420,16 @@       ewmhUpdateRateLimitMicroseconds = 100000     } -ewmhConfigFromSpec :: Maybe EWMHWorkspacesSpec -> EWMHWorkspaces.WorkspacesConfig+ewmhConfigFromSpec :: Maybe EWMHWorkspacesSpec -> WorkspacesConfig ewmhConfigFromSpec maybeSpec =   let spec = fromMaybe defaultEWMHWorkspacesSpec maybeSpec-      base = EWMHWorkspaces.defaultWorkspacesConfig-      common = EWMHWorkspaces.workspacesCommonConfig base-      common' =-        common-          { WorkspaceConfig.minIcons = naturalToInt (ewmhMinIcons spec),-            WorkspaceConfig.maxIcons = fmap naturalToInt (ewmhMaxIcons spec),-            WorkspaceConfig.widgetGap = naturalToInt (ewmhWidgetGap spec),-            WorkspaceConfig.showWorkspaceFn = if ewmhShowEmpty spec then const True else EWMHWorkspaces.hideEmpty,-            WorkspaceConfig.urgentWorkspaceState = ewmhUrgentWorkspaceState spec-          }-      base' = EWMHWorkspaces.applyCommonWorkspacesConfig common' base-   in base'-        { EWMHWorkspaces.borderWidth = naturalToInt (ewmhBorderWidth spec),-          EWMHWorkspaces.updateRateLimitMicroseconds = fromIntegral (ewmhUpdateRateLimitMicroseconds spec)+      base = defaultEWMHWorkspacesConfig+   in base+        { minIcons = naturalToInt (ewmhMinIcons spec),+          maxIcons = fmap naturalToInt (ewmhMaxIcons spec),+          widgetGap = naturalToInt (ewmhWidgetGap spec),+          showWorkspaceFn = if ewmhShowEmpty spec then const True else hideEmpty,+          urgentWorkspaceState = ewmhUrgentWorkspaceState spec         }  defaultHyprlandWorkspacesSpec :: HyprlandWorkspacesSpec@@ -456,31 +445,23 @@       hyprlandIconSize = 16     } -hyprlandConfigFromSpec :: Maybe HyprlandWorkspacesSpec -> HyprlandWorkspaces.HyprlandWorkspacesConfig+hyprlandConfigFromSpec :: Maybe HyprlandWorkspacesSpec -> WorkspacesConfig hyprlandConfigFromSpec maybeSpec =   let spec = fromMaybe defaultHyprlandWorkspacesSpec maybeSpec-      base = HyprlandWorkspaces.defaultHyprlandWorkspacesConfig-      common = HyprlandWorkspaces.hyprlandWorkspacesCommonConfig base+      base = defaultWorkspacesConfig       shouldShowWorkspace ws =-        let isEmpty = HyprlandWorkspaces.workspaceState ws == WorkspaceShared.Empty-            isSpecial =-              let name = T.toLower $ T.pack $ HyprlandWorkspaces.workspaceName ws-               in T.isPrefixOf "special" name || HyprlandWorkspaces.workspaceIdx ws < 0+        let isEmpty = WorkspaceModel.workspaceState ws == WorkspaceModel.WorkspaceEmpty+            isSpecial = WorkspaceModel.workspaceIsSpecial ws             emptyAllowed = hyprlandShowEmpty spec || not isEmpty             specialAllowed = hyprlandShowSpecial spec || not isSpecial          in emptyAllowed && specialAllowed-      common' =-        common-          { WorkspaceConfig.minIcons = naturalToInt (hyprlandMinIcons spec),-            WorkspaceConfig.maxIcons = fmap naturalToInt (hyprlandMaxIcons spec),-            WorkspaceConfig.widgetGap = naturalToInt (hyprlandWidgetGap spec),-            WorkspaceConfig.showWorkspaceFn = shouldShowWorkspace,-            WorkspaceConfig.urgentWorkspaceState = hyprlandUrgentWorkspaceState spec-          }-      base' = HyprlandWorkspaces.applyCommonHyprlandWorkspacesConfig common' base-   in base'-        { HyprlandWorkspaces.updateIntervalSeconds = hyprlandUpdateIntervalSeconds spec,-          HyprlandWorkspaces.iconSize = fromIntegral (hyprlandIconSize spec)+   in base+        { minIcons = naturalToInt (hyprlandMinIcons spec),+          maxIcons = fmap naturalToInt (hyprlandMaxIcons spec),+          widgetGap = naturalToInt (hyprlandWidgetGap spec),+          showWorkspaceFn = shouldShowWorkspace,+          urgentWorkspaceState = hyprlandUrgentWorkspaceState spec,+          iconSize = Just (fromIntegral (hyprlandIconSize spec))         }  screenLockConfigFromSpec :: Maybe ScreenLockSpec -> ScreenLock.ScreenLockConfig

@@ -30,8 +30,7 @@ import System.Taffybar.SimpleConfig import System.Taffybar.Widget import System.Taffybar.Widget.Generic.PollingGraph-import qualified System.Taffybar.Widget.Workspaces.Config as WorkspaceConfig-import qualified System.Taffybar.Widget.Workspaces.EWMH as Workspaces+import qualified System.Taffybar.Widget.Workspaces as Workspaces  -- | Fully transparent RGBA color. transparent :: (Double, Double, Double, Double)@@ -102,15 +101,11 @@ exampleTaffybarConfig =   let myWorkspacesConfig :: Workspaces.WorkspacesConfig       myWorkspacesConfig =-        let cfg = def-         in cfg-              { Workspaces.workspacesConfig =-                  (Workspaces.workspacesConfig cfg)-                    { WorkspaceConfig.minIcons = 1,-                      WorkspaceConfig.widgetGap = 0,-                      WorkspaceConfig.showWorkspaceFn = Workspaces.hideEmpty-                    }-              }+        def+          { Workspaces.minIcons = 1,+            Workspaces.widgetGap = 0,+            Workspaces.showWorkspaceFn = Workspaces.hideEmpty+          }       workspaces = Workspaces.workspacesNew myWorkspacesConfig       cpu = cpuMonitorNew cpuCfg 0.5 "cpu"       mem = pollingGraphNew memCfg 1 memCallback

@@ -101,38 +101,6 @@   -- * "System.Taffybar.Widget.Windows"   , module System.Taffybar.Widget.Windows -  -- * "System.Taffybar.Widget.ChannelWorkspaces"-  , ChannelWorkspacesConfig-  , defaultChannelWorkspacesConfig-  , defaultChannelEWMHWorkspacesConfig-  , channelWorkspacesNew--  -- * "System.Taffybar.Widget.HyprlandWorkspaces"-  , HyprlandWorkspacesConfig(..)-  , defaultHyprlandWorkspacesConfig-  , hyprlandWorkspacesNew-  , HyprlandWorkspace(..)-  , HyprlandWindow(..)-  , HyprlandWindowIconPixbufGetter-  , HyprlandWorkspaceWidgetController(..)-  , HyprlandWWC(..)-  , HyprlandControllerConstructor-  , HyprlandParentControllerConstructor-  , hyprlandBuildLabelController-  , hyprlandBuildIconController-  , hyprlandBuildContentsController-  , hyprlandBuildLabelOverlayController-  , hyprlandBuildCustomOverlayController-  , hyprlandBuildButtonController-  , defaultHyprlandWidgetBuilder-  , defaultHyprlandGetWindowIconPixbuf-  , getHyprlandWorkspaces-  , hyprlandSwitchToWorkspace-  , getActiveWindowAddress-  , runHyprctlJson-  , HyprlandClient(..)-  , windowFromClient-   -- * "System.Taffybar.Widget.Workspaces"   , module System.Taffybar.Widget.Workspaces @@ -140,8 +108,6 @@   , module System.Taffybar.Widget.XDGMenu.MenuWidget   ) where -import qualified GI.Gtk as Gtk-import System.Taffybar.Context (TaffyIO) import System.Taffybar.Widget.Battery import System.Taffybar.Widget.BatteryDonut import System.Taffybar.Widget.BatteryTextIcon@@ -174,40 +140,5 @@ import System.Taffybar.Widget.Backlight import System.Taffybar.Widget.Weather import System.Taffybar.Widget.Windows-import System.Taffybar.Widget.Workspaces.Hyprland hiding-  ( HyprlandWorkspacesConfig(..)-  , defaultHyprlandWorkspacesConfig-  , hyprlandBuildButtonController-  , hyprlandBuildContentsController-  , hyprlandBuildCustomOverlayController-  , hyprlandBuildIconController-  , hyprlandBuildLabelController-  , hyprlandBuildLabelOverlayController-  , hyprlandWorkspacesNew-  , defaultHyprlandWidgetBuilder-  )-import System.Taffybar.Widget.Workspaces.Hyprland.Compat-  ( HyprlandWorkspacesConfig(..)-  , defaultHyprlandWorkspacesConfig-  , hyprlandWorkspacesNew-  , hyprlandBuildLabelController-  , hyprlandBuildIconController-  , hyprlandBuildContentsController-  , hyprlandBuildLabelOverlayController-  , hyprlandBuildCustomOverlayController-  , hyprlandBuildButtonController-  , defaultHyprlandWidgetBuilder-  ) import System.Taffybar.Widget.Workspaces import System.Taffybar.Widget.XDGMenu.MenuWidget--type ChannelWorkspacesConfig = WorkspacesConfig--defaultChannelWorkspacesConfig :: ChannelWorkspacesConfig-defaultChannelWorkspacesConfig = defaultWorkspacesConfig--defaultChannelEWMHWorkspacesConfig :: ChannelWorkspacesConfig-defaultChannelEWMHWorkspacesConfig = defaultEWMHWorkspacesConfig--channelWorkspacesNew :: ChannelWorkspacesConfig -> TaffyIO Gtk.Widget-channelWorkspacesNew = workspacesNew

@@ -1,42 +0,0 @@----------------------------------------------------------------------------------------------------------------------------------------------------------------- |--- Module      : System.Taffybar.Widget.ChannelWorkspaces--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable------ Transitional, prefixed exports for the channel-driven Workspaces widget.------ The canonical API lives in "System.Taffybar.Widget.Workspaces"--- (with names like 'workspacesNew'). This module provides prefixed aliases so--- "System.Taffybar.Widget" can expose the new widget without colliding with--- legacy workspace exports.-module System.Taffybar.Widget.ChannelWorkspaces-  {-# DEPRECATED "Use System.Taffybar.Widget.Workspaces instead." #-}-  ( ChannelWorkspacesConfig,-    defaultChannelWorkspacesConfig,-    defaultChannelEWMHWorkspacesConfig,-    channelWorkspacesNew,-  )-where--import qualified GI.Gtk as Gtk-import System.Taffybar.Context (TaffyIO)-import qualified System.Taffybar.Widget.Workspaces as Channel--type ChannelWorkspacesConfig = Channel.WorkspacesConfig--defaultChannelWorkspacesConfig :: ChannelWorkspacesConfig-defaultChannelWorkspacesConfig = Channel.defaultWorkspacesConfig--defaultChannelEWMHWorkspacesConfig :: ChannelWorkspacesConfig-defaultChannelEWMHWorkspacesConfig = Channel.defaultEWMHWorkspacesConfig--channelWorkspacesNew :: ChannelWorkspacesConfig -> TaffyIO Gtk.Widget-channelWorkspacesNew = Channel.workspacesNew

@@ -1,67 +0,0 @@----------------------------------------------------------------------------------------------------------------------------------------------------------------- |--- Module      : System.Taffybar.Widget.HyprlandWorkspaces--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable-module System.Taffybar.Widget.HyprlandWorkspaces-  {-# DEPRECATED "Legacy Hyprland workspaces widget API. Use System.Taffybar.Widget.Workspaces (or System.Taffybar.Widget.ChannelWorkspaces) instead." #-}-  ( module System.Taffybar.Widget.Workspaces.Hyprland,-    HyprlandWorkspacesConfig (..),-    defaultHyprlandWorkspacesConfig,-    hyprlandWorkspacesNew,-    hyprlandWorkspacesCommonConfig,-    applyCommonHyprlandWorkspacesConfig,-    refreshWorkspaces,-    applyUrgentState,-    hyprlandBuildLabelController,-    hyprlandBuildIconController,-    hyprlandBuildContentsController,-    hyprlandBuildLabelOverlayController,-    hyprlandBuildCustomOverlayController,-    hyprlandBuildButtonController,-    defaultHyprlandWidgetBuilder,-    buildIconWidget,-  )-where--import System.Taffybar.Widget.Workspaces.Hyprland hiding-  ( HyprlandWorkspacesConfig (..),-    applyCommonHyprlandWorkspacesConfig,-    applyUrgentState,-    buildIconWidget,-    defaultHyprlandWidgetBuilder,-    defaultHyprlandWorkspacesConfig,-    hyprlandBuildButtonController,-    hyprlandBuildContentsController,-    hyprlandBuildCustomOverlayController,-    hyprlandBuildIconController,-    hyprlandBuildLabelController,-    hyprlandBuildLabelOverlayController,-    hyprlandWorkspacesCommonConfig,-    hyprlandWorkspacesNew,-    refreshWorkspaces,-  )-import System.Taffybar.Widget.Workspaces.Hyprland.Compat-  ( HyprlandWorkspacesConfig (..),-    applyCommonHyprlandWorkspacesConfig,-    applyUrgentState,-    buildIconWidget,-    defaultHyprlandWidgetBuilder,-    defaultHyprlandWorkspacesConfig,-    hyprlandBuildButtonController,-    hyprlandBuildContentsController,-    hyprlandBuildCustomOverlayController,-    hyprlandBuildIconController,-    hyprlandBuildLabelController,-    hyprlandBuildLabelOverlayController,-    hyprlandWorkspacesCommonConfig,-    hyprlandWorkspacesNew,-    refreshWorkspaces,-  )

@@ -448,8 +448,15 @@       forceIconRefresh =         snapshotBackend snapshot == WorkspaceBackendEWMH           && snapshotRevision snapshot /= cacheLastRevision oldCache+      applyVisibility wsInfo entry =+        if showWorkspaceFn cfg wsInfo+          then liftIO $ Gtk.widgetShow (entryButton entry)+          else liftIO $ Gtk.widgetHide (entryButton entry)   if workspaces == cacheLastWorkspaces oldCache && not forceIconRefresh-    then return oldCache+    then do+      forM_ (M.elems $ cacheEntries oldCache) $ \entry ->+        applyVisibility (entryLastWorkspace entry) entry+      return oldCache     else do       let oldEntries = cacheEntries oldCache           buildOrUpdate (cacheAcc, entriesAcc) wsInfo = do@@ -482,10 +489,7 @@       when needsReorder $         forM_ (zip [0 :: Int ..] orderedEntries) $ \(position, (_wsInfo, entry)) ->           liftIO $ Gtk.boxReorderChild cont (entryWrapper entry) (fromIntegral position)-      forM_ orderedEntries $ \(wsInfo, entry) ->-        if showWorkspaceFn cfg wsInfo-          then liftIO $ Gtk.widgetShow (entryButton entry)-          else liftIO $ Gtk.widgetHide (entryButton entry)+      forM_ orderedEntries $ uncurry applyVisibility       return         WorkspaceCache           { cacheEntries = newEntries,

@@ -1,21 +0,0 @@-{-# OPTIONS_GHC -Wno-deprecations #-}------------------------------------------------------------------------------------------------------------------------------------------------------------------ |--- Module      : System.Taffybar.Widget.Workspaces.Channel--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable-module System.Taffybar.Widget.Workspaces.Channel-  {-# DEPRECATED "Use System.Taffybar.Widget.Workspaces instead." #-}-  ( module System.Taffybar.Widget.Workspaces,-  )-where--import System.Taffybar.Widget.Workspaces

@@ -1,19 +0,0 @@----------------------------------------------------------------------------------------------------------------------------------------------------------------- |--- Module      : System.Taffybar.Widget.Workspaces.Common--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable-module System.Taffybar.Widget.Workspaces.Common-  {-# DEPRECATED "Use System.Taffybar.Widget.Workspaces.Config" #-}-  ( module System.Taffybar.Widget.Workspaces.Config,-  )-where--import System.Taffybar.Widget.Workspaces.Config

@@ -1,41 +0,0 @@-{-# LANGUAGE RankNTypes #-}------------------------------------------------------------------------------------------------------------------------------------------------------------------ |--- Module      : System.Taffybar.Widget.Workspaces.Config--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable------ Shared configuration shape used by both workspace widgets.-module System.Taffybar.Widget.Workspaces.Config-  ( WorkspaceWidgetCommonConfig (..),-  )-where--import Data.Int (Int32)-import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk-import System.Taffybar.Context (TaffyIO)---- | Common, backend-agnostic workspace-widget configuration.------ The @m@ type parameter captures the backend-specific context monad used for--- widget/controller updates.-data WorkspaceWidgetCommonConfig m workspace window controller-  = WorkspaceWidgetCommonConfig-  { widgetBuilder :: workspace -> m controller,-    widgetGap :: Int,-    maxIcons :: Maybe Int,-    minIcons :: Int,-    getWindowIconPixbuf :: Int32 -> window -> TaffyIO (Maybe Gdk.Pixbuf),-    labelSetter :: workspace -> m String,-    showWorkspaceFn :: workspace -> Bool,-    iconSort :: [window] -> m [window],-    urgentWorkspaceState :: Bool-  }

@@ -1,884 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StrictData #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}------------------------------------------------------------------------------------------------------------------------------------------------------------------ |--- Module      : System.Taffybar.Widget.Workspaces.EWMH--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable-module System.Taffybar.Widget.Workspaces.EWMH-  ( module System.Taffybar.Widget.Workspaces.EWMH,-    module System.Taffybar.Widget.Workspaces.Shared,-    module System.Taffybar.Widget.Workspaces.Config,-  )-where--import Control.Arrow ((&&&))-import Control.Concurrent-import qualified Control.Concurrent.MVar as MV-import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Control.Monad.Trans.Reader-import Control.RateLimit-import Data.Char (toLower)-import Data.Default (Default (..))-import qualified Data.Foldable as F-import Data.GI.Base.ManagedPtr (unsafeCastTo)-import Data.Int-import Data.List (elemIndex, intersect, isPrefixOf, sortBy, (\\))-import qualified Data.Map as M-import Data.Maybe-import qualified Data.MultiMap as MM-import qualified Data.Set as Set-import qualified Data.Text as T-import Data.Time.Units-import Data.Tuple.Select-import Data.Tuple.Sequence-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 System.Log.Logger-import System.Taffybar.Context-import System.Taffybar.Information.EWMHDesktopInfo-import System.Taffybar.Information.SafeX11-import System.Taffybar.Information.X11DesktopInfo-import System.Taffybar.Util-import System.Taffybar.Widget.Generic.ScalingImage (getScalingImageStrategy)-import System.Taffybar.Widget.Util-import System.Taffybar.Widget.Workspaces.Config-  ( WorkspaceWidgetCommonConfig (WorkspaceWidgetCommonConfig),-  )-import qualified System.Taffybar.Widget.Workspaces.Config as WorkspaceWidgetConfig-import System.Taffybar.Widget.Workspaces.Shared-  ( WorkspaceState (..),-    buildWorkspaceIconLabelOverlay,-    cssWorkspaceStates,-    getCSSClass,-    mkWorkspaceIconWidget,-    setWorkspaceWidgetStatusClass,-  )-import System.Taffybar.WindowIcon-import Text.Printf--data WindowData = WindowData-  { windowId :: X11Window,-    windowTitle :: String,-    windowClass :: String,-    windowUrgent :: Bool,-    windowActive :: Bool,-    windowMinimized :: Bool-  }-  deriving (Show, Eq)--data WidgetUpdate = WorkspaceUpdate Workspace | IconUpdate [X11Window]--data Workspace = Workspace-  { workspaceIdx :: WorkspaceId,-    workspaceName :: String,-    workspaceState :: WorkspaceState,-    windows :: [WindowData]-  }-  deriving (Show, Eq)--data WorkspacesContext = WorkspacesContext-  { controllersVar :: MV.MVar (M.Map WorkspaceId WWC),-    workspacesVar :: MV.MVar (M.Map WorkspaceId Workspace),-    workspacesWidget :: Gtk.Box,-    ewmhConfig :: WorkspacesConfig,-    taffyContext :: Context-  }--type WorkspacesIO a = ReaderT WorkspacesContext IO a--liftContext :: TaffyIO a -> WorkspacesIO a-liftContext action = asks taffyContext >>= lift . runReaderT action--liftX11Def :: a -> X11Property a -> WorkspacesIO a-liftX11Def dflt prop = liftContext $ runX11Def dflt prop--class WorkspaceWidgetController wc where-  getWidget :: wc -> WorkspacesIO Gtk.Widget-  updateWidget :: wc -> WidgetUpdate -> WorkspacesIO wc-  updateWidgetX11 :: wc -> WidgetUpdate -> WorkspacesIO wc-  updateWidgetX11 cont _ = return cont--data WWC = forall a. (WorkspaceWidgetController a) => WWC a--instance WorkspaceWidgetController WWC where-  getWidget (WWC wc) = getWidget wc-  updateWidget (WWC wc) update = WWC <$> updateWidget wc update-  updateWidgetX11 (WWC wc) update = WWC <$> updateWidgetX11 wc update--type ControllerConstructor = Workspace -> WorkspacesIO WWC--type ParentControllerConstructor =-  ControllerConstructor -> ControllerConstructor--type WindowIconPixbufGetter =-  Int32 -> WindowData -> TaffyIO (Maybe Gdk.Pixbuf)--data WorkspacesConfig-  = WorkspacesConfig-  { workspacesConfig ::-      WorkspaceWidgetCommonConfig-        (ReaderT WorkspacesContext IO)-        Workspace-        WindowData-        WWC,-    borderWidth :: Int,-    updateEvents :: [String],-    updateRateLimitMicroseconds :: Integer-  }--workspacesCommonConfig ::-  WorkspacesConfig ->-  WorkspaceWidgetCommonConfig (ReaderT WorkspacesContext IO) Workspace WindowData WWC-workspacesCommonConfig = workspacesConfig---- | Modify the nested 'WorkspaceWidgetCommonConfig' inside a 'WorkspacesConfig'.------ Prefer this helper when overriding multiple fields to avoid accidentally--- introducing a self-recursive config definition that can hang at runtime.-modifyCommonWorkspacesConfig ::-  ( WorkspaceWidgetCommonConfig (ReaderT WorkspacesContext IO) Workspace WindowData WWC ->-    WorkspaceWidgetCommonConfig (ReaderT WorkspacesContext IO) Workspace WindowData WWC-  ) ->-  WorkspacesConfig ->-  WorkspacesConfig-modifyCommonWorkspacesConfig f cfg =-  cfg {workspacesConfig = f (workspacesConfig cfg)}---- | Replace the nested common config inside 'WorkspacesConfig'.------ If you're just tweaking a few fields, prefer 'modifyCommonWorkspacesConfig'--- to avoid accidentally creating a self-recursive definition that can hang at--- runtime.-applyCommonWorkspacesConfig ::-  WorkspaceWidgetCommonConfig (ReaderT WorkspacesContext IO) Workspace WindowData WWC ->-  WorkspacesConfig ->-  WorkspacesConfig-applyCommonWorkspacesConfig common cfg =-  cfg {workspacesConfig = common}--defaultWorkspacesConfig :: WorkspacesConfig-defaultWorkspacesConfig =-  WorkspacesConfig-    { workspacesConfig =-        WorkspaceWidgetCommonConfig-          { WorkspaceWidgetConfig.widgetBuilder =-              buildButtonController defaultBuildContentsController,-            WorkspaceWidgetConfig.widgetGap = 0,-            WorkspaceWidgetConfig.maxIcons = Nothing,-            WorkspaceWidgetConfig.minIcons = 0,-            WorkspaceWidgetConfig.getWindowIconPixbuf = defaultGetWindowIconPixbuf,-            WorkspaceWidgetConfig.labelSetter = return . workspaceName,-            WorkspaceWidgetConfig.showWorkspaceFn = \ws -> hideEmpty ws && hideSpecial ws,-            WorkspaceWidgetConfig.iconSort = sortWindowsByPosition,-            WorkspaceWidgetConfig.urgentWorkspaceState = False-          },-      borderWidth = 2,-      updateEvents = allEWMHProperties \\ [ewmhWMIcon],-      updateRateLimitMicroseconds = 100000-    }--instance Default WorkspacesConfig where-  def = defaultWorkspacesConfig--hideEmpty :: Workspace -> Bool-hideEmpty Workspace {workspaceState = Empty} = False-hideEmpty _ = True--hideSpecial :: Workspace -> Bool-hideSpecial Workspace {workspaceName = name} =-  let lowered = map toLower name-   in lowered /= "nsp" && not ("special:" `isPrefixOf` lowered)--wLog :: (MonadIO m) => Priority -> String -> m ()-wLog l s = liftIO $ logM "System.Taffybar.Widget.Workspaces" l s--updateVar :: MV.MVar a -> (a -> WorkspacesIO a) -> WorkspacesIO a-updateVar var modify = do-  ctx <- ask-  lift $ MV.modifyMVar var $ fmap (\a -> (a, a)) . flip runReaderT ctx . modify--updateWorkspacesVar :: WorkspacesIO (M.Map WorkspaceId Workspace)-updateWorkspacesVar = do-  workspacesRef <- asks workspacesVar-  updateVar workspacesRef buildWorkspaceData--getWorkspaceToWindows ::-  [X11Window] -> X11Property (MM.MultiMap WorkspaceId X11Window)-getWorkspaceToWindows =-  foldM-    ( \theMap window ->-        MM.insert <$> getWorkspace window <*> pure window <*> pure theMap-    )-    MM.empty--getWindowData ::-  Maybe X11Window ->-  [X11Window] ->-  X11Window ->-  X11Property WindowData-getWindowData activeWindow urgentWindows window = do-  wTitle <- getWindowTitle window-  wClass <- getWindowClass window-  wMinimized <- getWindowMinimized window-  return-    WindowData-      { windowId = window,-        windowTitle = wTitle,-        windowClass = wClass,-        windowUrgent = window `elem` urgentWindows,-        windowActive = Just window == activeWindow,-        windowMinimized = wMinimized-      }--buildWorkspaceData ::-  M.Map WorkspaceId Workspace ->-  WorkspacesIO (M.Map WorkspaceId Workspace)-buildWorkspaceData _ =-  ask >>= \context -> liftX11Def M.empty $ do-    names <- getWorkspaceNames-    wins <- getWindows-    workspaceToWindows <- getWorkspaceToWindows wins-    urgentWindows <- filterM isWindowUrgent wins-    activeWindow <- getActiveWindow-    active : visible <- getVisibleWorkspaces-    let common = workspacesCommonConfig (ewmhConfig context)-        getWorkspaceState idx ws-          | idx == active = Active-          | idx `elem` visible = Visible-          | WorkspaceWidgetConfig.urgentWorkspaceState common-              && not (null (ws `intersect` urgentWindows)) =-              Urgent-          | null ws = Empty-          | otherwise = Hidden-    foldM-      ( \theMap (idx, name) -> do-          let ws = MM.lookup idx workspaceToWindows-          windowInfos <- mapM (getWindowData activeWindow urgentWindows) ws-          return $-            M.insert-              idx-              Workspace-                { workspaceIdx = idx,-                  workspaceName = name,-                  workspaceState = getWorkspaceState idx ws,-                  windows = windowInfos-                }-              theMap-      )-      M.empty-      names--addWidgetsToTopLevel :: WorkspacesIO ()-addWidgetsToTopLevel = do-  WorkspacesContext-    { controllersVar = controllersRef,-      workspacesWidget = cont-    } <--    ask-  controllersMap <- lift $ MV.readMVar controllersRef-  -- Elems returns elements in ascending order of their keys so this will always-  -- add the widgets in the correct order-  mapM_ addWidget $ M.elems controllersMap-  lift $ Gtk.widgetShowAll cont--addWidget :: WWC -> WorkspacesIO ()-addWidget controller = do-  cont <- asks workspacesWidget-  workspaceWidget <- getWidget controller-  lift $ do-    -- XXX: This hbox exists to (hopefully) prevent the issue where workspace-    -- widgets appear out of order, in the switcher, by acting as an empty-    -- place holder when the actual widget is hidden.-    hbox <- Gtk.boxNew Gtk.OrientationHorizontal 0-    void $-      Gtk.widgetGetParent workspaceWidget-        >>= traverse (unsafeCastTo Gtk.Box)-        >>= traverse (`Gtk.containerRemove` workspaceWidget)-    Gtk.containerAdd hbox workspaceWidget-    Gtk.containerAdd cont hbox--workspacesNew :: WorkspacesConfig -> TaffyIO Gtk.Widget-workspacesNew cfg =-  ask >>= \tContext -> lift $ do-    let common = workspacesCommonConfig cfg-    cont <- Gtk.boxNew Gtk.OrientationHorizontal $ fromIntegral (WorkspaceWidgetConfig.widgetGap common)-    controllersRef <- MV.newMVar M.empty-    workspacesRef <- MV.newMVar M.empty-    let context =-          WorkspacesContext-            { controllersVar = controllersRef,-              workspacesVar = workspacesRef,-              workspacesWidget = cont,-              ewmhConfig = cfg,-              taffyContext = tContext-            }-    -- This will actually create all the widgets-    runReaderT updateAllWorkspaceWidgets context-    updateHandler <- onWorkspaceUpdate context-    iconHandler <- onIconsChanged context-    let doUpdate = lift . updateHandler-        handleConfigureEvents e@(ConfigureEvent {}) = doUpdate e-        handleConfigureEvents _ = return ()-    (workspaceSubscription, iconSubscription, geometrySubscription) <--      flip runReaderT tContext $-        sequenceT-          ( subscribeToPropertyEvents (updateEvents cfg) doUpdate,-            subscribeToPropertyEvents [ewmhWMIcon] (lift . onIconChanged iconHandler),-            subscribeToAll handleConfigureEvents-          )-    let doUnsubscribe =-          flip runReaderT tContext $-            mapM_-              unsubscribe-              [ iconSubscription,-                workspaceSubscription,-                geometrySubscription-              ]-    _ <- Gtk.onWidgetUnrealize cont doUnsubscribe-    _ <- widgetSetClassGI cont "workspaces"-    Gtk.toWidget cont--updateAllWorkspaceWidgets :: WorkspacesIO ()-updateAllWorkspaceWidgets = do-  wLog DEBUG "Updating workspace widgets"--  workspacesMap <- updateWorkspacesVar-  wLog DEBUG $ printf "Workspaces: %s" $ show workspacesMap--  wLog DEBUG "Adding and removing widgets"-  updateWorkspaceControllers--  let updateController' idx controller =-        maybe-          (return controller)-          (updateWidget controller . WorkspaceUpdate)-          $ M.lookup idx workspacesMap-      logUpdateController i =-        wLog DEBUG $ printf "Updating %s workspace widget" $ show i-      updateController i cont =-        logUpdateController i-          >> updateController' i cont--  wLog DEBUG "Done updating individual widget"--  doWidgetUpdate updateController--  wLog DEBUG "Showing and hiding controllers"-  setControllerWidgetVisibility--setControllerWidgetVisibility :: WorkspacesIO ()-setControllerWidgetVisibility = do-  ctx@WorkspacesContext-    { workspacesVar = workspacesRef,-      controllersVar = controllersRef,-      ewmhConfig = cfg-    } <--    ask-  let common = workspacesCommonConfig cfg-  lift $ do-    workspacesMap <- MV.readMVar workspacesRef-    controllersMap <- MV.readMVar controllersRef-    forM_ (M.elems workspacesMap) $ \ws ->-      let action =-            if WorkspaceWidgetConfig.showWorkspaceFn common ws-              then Gtk.widgetShow-              else Gtk.widgetHide-       in traverse-            (flip runReaderT ctx . getWidget)-            (M.lookup (workspaceIdx ws) controllersMap)-            >>= maybe (return ()) action--doWidgetUpdate :: (WorkspaceId -> WWC -> WorkspacesIO WWC) -> WorkspacesIO ()-doWidgetUpdate updateController = do-  c@WorkspacesContext {controllersVar = controllersRef} <- ask-  lift $ MV.modifyMVar_ controllersRef $ \controllers -> do-    wLog DEBUG "Updating controllers ref"-    controllersList <--      mapM-        ( \(idx, controller) -> do-            newController <- runReaderT (updateController idx controller) c-            return (idx, newController)-        )-        $ M.toList controllers-    return $ M.fromList controllersList--updateWorkspaceControllers :: WorkspacesIO ()-updateWorkspaceControllers = do-  WorkspacesContext-    { controllersVar = controllersRef,-      workspacesVar = workspacesRef,-      workspacesWidget = cont,-      ewmhConfig = cfg-    } <--    ask-  workspacesMap <- lift $ MV.readMVar workspacesRef-  controllersMap <- lift $ MV.readMVar controllersRef--  let newWorkspacesSet = M.keysSet workspacesMap-      existingWorkspacesSet = M.keysSet controllersMap-      common = workspacesCommonConfig cfg--  when (existingWorkspacesSet /= newWorkspacesSet) $ do-    let addWorkspaces = Set.difference newWorkspacesSet existingWorkspacesSet-        removeWorkspaces = Set.difference existingWorkspacesSet newWorkspacesSet-        builder = WorkspaceWidgetConfig.widgetBuilder common--    _ <- updateVar controllersRef $ \controllers -> do-      let oldRemoved = F.foldl' (flip M.delete) controllers removeWorkspaces-          buildController idx = builder <$> M.lookup idx workspacesMap-          buildAndAddController theMap idx =-            maybe-              (return theMap)-              (>>= return . flip (M.insert idx) theMap)-              (buildController idx)-      foldM buildAndAddController oldRemoved $ Set.toList addWorkspaces-    -- Clear the container and repopulate it-    lift $ Gtk.containerForeach cont (Gtk.containerRemove cont)-    addWidgetsToTopLevel--rateLimitFn ::-  forall req resp.-  WorkspacesContext ->-  (req -> IO resp) ->-  ResultsCombiner req resp ->-  IO (req -> IO resp)-rateLimitFn context =-  let limit = (updateRateLimitMicroseconds $ ewmhConfig context)-      rate = fromMicroseconds limit :: Microsecond-   in generateRateLimitedFunction $ PerInvocation rate--onWorkspaceUpdate :: WorkspacesContext -> IO (Event -> IO ())-onWorkspaceUpdate context = do-  rateLimited <- rateLimitFn context doUpdate combineRequests-  let withLog event = do-        case event of-          PropertyEvent _ _ _ _ _ atom _ _ ->-            wLog DEBUG $ printf "Event %s" $ show atom-          _anythingElse -> return ()-        void $ forkIO $ rateLimited event-  return withLog-  where-    combineRequests _ b = Just (b, const ((), ()))-    doUpdate _ = postGUIASync $ runReaderT updateAllWorkspaceWidgets context--onIconChanged :: (Set.Set X11Window -> IO ()) -> Event -> IO ()-onIconChanged handler event =-  case event of-    PropertyEvent {ev_window = wid} -> do-      wLog DEBUG $ printf "Icon changed event %s" $ show wid-      handler $ Set.singleton wid-    _ -> return ()--onIconsChanged :: WorkspacesContext -> IO (Set.Set X11Window -> IO ())-onIconsChanged context = rateLimitFn context onIconsChanged' combineRequests-  where-    combineRequests windows1 windows2 =-      Just (Set.union windows1 windows2, const ((), ()))-    onIconsChanged' wids = do-      wLog DEBUG $ printf "Icon update execute %s" $ show wids-      postGUIASync $-        flip runReaderT context $-          doWidgetUpdate-            ( \idx c ->-                wLog DEBUG (printf "Updating %s icons." $ show idx)-                  >> updateWidget c (IconUpdate $ Set.toList wids)-            )--initializeWWC ::-  (WorkspaceWidgetController a) => a -> Workspace -> ReaderT WorkspacesContext IO WWC-initializeWWC controller ws =-  WWC <$> updateWidget controller (WorkspaceUpdate ws)---- | A WrappingController can be used to wrap some child widget with another--- abitrary widget.-data WrappingController = WrappingController-  { wrappedWidget :: Gtk.Widget,-    wrappedController :: WWC-  }--instance WorkspaceWidgetController WrappingController where-  getWidget = lift . Gtk.toWidget . wrappedWidget-  updateWidget wc update = do-    updated <- updateWidget (wrappedController wc) update-    return wc {wrappedController = updated}--data WorkspaceContentsController = WorkspaceContentsController-  { containerWidget :: Gtk.Widget,-    contentsControllers :: [WWC]-  }--buildContentsController :: [ControllerConstructor] -> ControllerConstructor-buildContentsController constructors ws = do-  controllers <- mapM ($ ws) constructors-  ctx <- ask-  tempController <- lift $ do-    cons <- Gtk.boxNew Gtk.OrientationHorizontal 0-    mapM_ (flip runReaderT ctx . getWidget >=> Gtk.containerAdd cons) controllers-    outerBox <- Gtk.toWidget cons >>= buildPadBox-    _ <- widgetSetClassGI cons "contents"-    widget <- Gtk.toWidget outerBox-    return-      WorkspaceContentsController-        { containerWidget = widget,-          contentsControllers = controllers-        }-  initializeWWC tempController ws--defaultBuildContentsController :: ControllerConstructor-defaultBuildContentsController =-  buildContentsController [buildLabelController, buildIconController]--bottomLeftAlignedBoxWrapper :: T.Text -> ControllerConstructor -> ControllerConstructor-bottomLeftAlignedBoxWrapper boxClass constructor ws = do-  controller <- constructor ws-  widget <- getWidget controller-  wrapped <- lift $ buildBottomLeftAlignedBox boxClass widget-  let wrappingController =-        WrappingController-          { wrappedWidget = wrapped,-            wrappedController = controller-          }-  initializeWWC wrappingController ws--buildLabelOverlayController :: ControllerConstructor-buildLabelOverlayController ws = do-  iconController <- buildIconController ws-  labelController <- buildLabelController ws-  ctx <- ask-  tempController <- lift $ do-    iconWidget <- runReaderT (getWidget iconController) ctx-    labelWidget <- runReaderT (getWidget labelController) ctx-    widget <- buildWorkspaceIconLabelOverlay iconWidget labelWidget-    return-      WorkspaceContentsController-        { containerWidget = widget,-          contentsControllers = [iconController, labelController]-        }-  initializeWWC tempController ws--buildOverlayContentsController ::-  [ControllerConstructor] -> [ControllerConstructor] -> ControllerConstructor-buildOverlayContentsController mainConstructors overlayConstructors ws = do-  controllers <- mapM ($ ws) mainConstructors-  overlayControllers <- mapM ($ ws) overlayConstructors-  ctx <- ask-  tempController <- lift $ do-    mainContents <- Gtk.boxNew Gtk.OrientationHorizontal 0-    mapM_-      (flip runReaderT ctx . getWidget >=> Gtk.containerAdd mainContents)-      controllers-    outerBox <- Gtk.toWidget mainContents >>= buildPadBox-    _ <- widgetSetClassGI mainContents "contents"-    overlayWidgets <- mapM (flip runReaderT ctx . getWidget) overlayControllers-    widget <- buildOverlayWithPassThrough outerBox overlayWidgets-    return-      WorkspaceContentsController-        { containerWidget = widget,-          contentsControllers = controllers ++ overlayControllers-        }-  initializeWWC tempController ws--instance WorkspaceWidgetController WorkspaceContentsController where-  getWidget = return . containerWidget-  updateWidget cc update = do-    WorkspacesContext {} <- ask-    case update of-      WorkspaceUpdate newWorkspace ->-        lift $ setWorkspaceWidgetStatusClass (workspaceState newWorkspace) $ containerWidget cc-      _ -> return ()-    newControllers <- mapM (`updateWidget` update) $ contentsControllers cc-    return cc {contentsControllers = newControllers}-  updateWidgetX11 cc update = do-    newControllers <- mapM (`updateWidgetX11` update) $ contentsControllers cc-    return cc {contentsControllers = newControllers}--newtype LabelController = LabelController {label :: Gtk.Label}--buildLabelController :: ControllerConstructor-buildLabelController ws = do-  tempController <- lift $ do-    lbl <- Gtk.labelNew Nothing-    _ <- widgetSetClassGI lbl "workspace-label"-    return LabelController {label = lbl}-  initializeWWC tempController ws--instance WorkspaceWidgetController LabelController where-  getWidget = lift . Gtk.toWidget . label-  updateWidget lc (WorkspaceUpdate newWorkspace) = do-    WorkspacesContext {ewmhConfig = cfg} <- ask-    let common = workspacesCommonConfig cfg-    labelText <- WorkspaceWidgetConfig.labelSetter common newWorkspace-    lift $ do-      Gtk.labelSetMarkup (label lc) $ T.pack labelText-      setWorkspaceWidgetStatusClass (workspaceState newWorkspace) $ label lc-    return lc-  updateWidget lc _ = return lc--type IconWidget = WindowIconWidget WindowData--buildIconWidget :: Bool -> Workspace -> WorkspacesIO IconWidget-buildIconWidget transparentOnNone ws = do-  ctx <- ask-  let tContext = taffyContext ctx-      cfg = ewmhConfig ctx-      common = workspacesCommonConfig cfg-      getPB size windowData =-        runReaderT (WorkspaceWidgetConfig.getWindowIconPixbuf common size windowData) tContext-  strategy <- liftContext getScalingImageStrategy-  lift $ do-    iconWidget <--      mkWorkspaceIconWidget-        strategy-        Nothing-        transparentOnNone-        getPB-        (`pixBufFromColor` 0)-    _ <--      Gtk.onWidgetButtonPressEvent (iconContainer iconWidget) $-        const $-          liftIO $ do-            info <- MV.readMVar (iconWindow iconWidget)-            case info of-              Just updatedInfo ->-                flip runReaderT ctx $-                  liftX11Def () $-                    focusWindow $-                      windowId updatedInfo-              _ -> liftIO $ void $ switch ctx (workspaceIdx ws)-            return True-    return iconWidget--data IconController = IconController-  { iconsContainer :: Gtk.Box,-    iconImages :: [IconWidget],-    iconWorkspace :: Workspace-  }--buildIconController :: ControllerConstructor-buildIconController ws = do-  tempController <--    lift $ do-      hbox <- Gtk.boxNew Gtk.OrientationHorizontal 0-      return-        IconController-          { iconsContainer = hbox,-            iconImages = [],-            iconWorkspace = ws-          }-  initializeWWC tempController ws--instance WorkspaceWidgetController IconController where-  getWidget = lift . Gtk.toWidget . iconsContainer-  updateWidget ic (WorkspaceUpdate newWorkspace) = do-    newImages <- updateImages ic newWorkspace-    return ic {iconImages = newImages, iconWorkspace = newWorkspace}-  updateWidget ic (IconUpdate updatedIcons) =-    updateWindowIconsById ic updatedIcons >> return ic--updateWindowIconsById ::-  IconController -> [X11Window] -> WorkspacesIO ()-updateWindowIconsById ic windowIds =-  mapM_ maybeUpdateWindowIcon $ iconImages ic-  where-    maybeUpdateWindowIcon widget =-      do-        info <- lift $ MV.readMVar $ iconWindow widget-        when (maybe False (flip elem windowIds . windowId) info) $-          updateIconWidget ic widget info--scaledWindowIconPixbufGetter :: WindowIconPixbufGetter -> WindowIconPixbufGetter-scaledWindowIconPixbufGetter = scaledPixbufGetter--constantScaleWindowIconPixbufGetter ::-  Int32 -> WindowIconPixbufGetter -> WindowIconPixbufGetter-constantScaleWindowIconPixbufGetter constantSize getter =-  const $ scaledWindowIconPixbufGetter getter constantSize--handleIconGetterException :: WindowIconPixbufGetter -> WindowIconPixbufGetter-handleIconGetterException = handlePixbufGetterException wLog--getWindowIconPixbufFromEWMH :: WindowIconPixbufGetter-getWindowIconPixbufFromEWMH = handleIconGetterException $ \size windowData ->-  getCachedIconPixBufFromEWMH size (windowId windowData)--getWindowIconPixbufFromClass :: WindowIconPixbufGetter-getWindowIconPixbufFromClass = handleIconGetterException $ \size windowData ->-  getCachedWindowIconFromClasses size (windowClass windowData)--getWindowIconPixbufFromDesktopEntry :: WindowIconPixbufGetter-getWindowIconPixbufFromDesktopEntry = handleIconGetterException $ \size windowData ->-  getCachedWindowIconFromDesktopEntryByClasses size (windowClass windowData)--getWindowIconPixbufFromChrome :: WindowIconPixbufGetter-getWindowIconPixbufFromChrome _ windowData =-  getPixBufFromChromeData $ windowId windowData--defaultGetWindowIconPixbuf :: WindowIconPixbufGetter-defaultGetWindowIconPixbuf =-  scaledWindowIconPixbufGetter unscaledDefaultGetWindowIconPixbuf--unscaledDefaultGetWindowIconPixbuf :: WindowIconPixbufGetter-unscaledDefaultGetWindowIconPixbuf =-  getWindowIconPixbufFromDesktopEntry-    <|||> getWindowIconPixbufFromClass-    <|||> getWindowIconPixbufFromEWMH--addCustomIconsToDefaultWithFallbackByPath ::-  (WindowData -> Maybe FilePath) ->-  FilePath ->-  WindowIconPixbufGetter-addCustomIconsToDefaultWithFallbackByPath getCustomIconPath fallbackPath =-  addCustomIconsAndFallback-    getCustomIconPath-    (const $ lift $ getPixbufFromFilePath fallbackPath)-    unscaledDefaultGetWindowIconPixbuf--addCustomIconsAndFallback ::-  (WindowData -> Maybe FilePath) ->-  (Int32 -> TaffyIO (Maybe Gdk.Pixbuf)) ->-  WindowIconPixbufGetter ->-  WindowIconPixbufGetter-addCustomIconsAndFallback getCustomIconPath fallback defaultGetter =-  scaledWindowIconPixbufGetter $-    getCustomIcon <|||> defaultGetter <|||> (\s _ -> fallback s)-  where-    getCustomIcon :: Int32 -> WindowData -> TaffyIO (Maybe Gdk.Pixbuf)-    getCustomIcon _ wdata =-      lift $-        maybe (return Nothing) getPixbufFromFilePath $-          getCustomIconPath wdata---- | Sort windows by top-left corner position.-sortWindowsByPosition :: [WindowData] -> WorkspacesIO [WindowData]-sortWindowsByPosition wins = do-  let getGeometryWorkspaces w = getDisplay >>= liftIO . (`safeGetGeometry` w)-      getGeometries =-        mapM-          ( forkM-              return-              (((sel2 &&& sel3) <$>) . getGeometryWorkspaces)-              . windowId-          )-          wins-  windowGeometries <- liftX11Def [] getGeometries-  let getLeftPos wd =-        fromMaybe (999999999, 99999999) $ lookup (windowId wd) windowGeometries-      compareWindowData a b =-        compare-          (windowMinimized a, getLeftPos a)-          (windowMinimized b, getLeftPos b)-  return $ sortBy compareWindowData wins---- | Sort windows in reverse _NET_CLIENT_LIST_STACKING order.--- Starting in xmonad-contrib 0.17.0, this is effectively focus history, active first.--- Previous versions erroneously stored focus-sort-order in _NET_CLIENT_LIST.-sortWindowsByStackIndex :: [WindowData] -> WorkspacesIO [WindowData]-sortWindowsByStackIndex wins = do-  stackingWindows <- liftX11Def [] getWindowsStacking-  let getStackIdx wd = fromMaybe (-1) $ elemIndex (windowId wd) stackingWindows-      compareWindowData a b = compare (getStackIdx b) (getStackIdx a)-  return $ sortBy compareWindowData wins--updateImages :: IconController -> Workspace -> WorkspacesIO [IconWidget]-updateImages ic ws = do-  WorkspacesContext {ewmhConfig = cfg} <- ask-  let common = workspacesCommonConfig cfg-  sortedWindows <- WorkspaceWidgetConfig.iconSort common $ windows ws-  wLog DEBUG $ printf "Updating images for %s" (show ws)-  let (effectiveMinIcons, _targetLen, paddedWindows) =-        computeIconStripLayout-          (WorkspaceWidgetConfig.minIcons common)-          (WorkspaceWidgetConfig.maxIcons common)-          sortedWindows-      buildOne i = buildIconWidget (i < effectiveMinIcons) ws-      updateOne = updateIconWidget ic-  syncWidgetPool (iconsContainer ic) (iconImages ic) paddedWindows buildOne iconContainer updateOne--getWindowStatusString :: WindowData -> T.Text-getWindowStatusString windowData =-  windowStatusClassFromFlags-    (windowMinimized windowData)-    (windowActive windowData)-    (windowUrgent windowData)--updateIconWidget ::-  IconController ->-  IconWidget ->-  Maybe WindowData ->-  WorkspacesIO ()-updateIconWidget _ iconWidget windowData =-  updateWindowIconWidgetState-    iconWidget-    windowData-    (T.pack . windowTitle)-    getWindowStatusString--data WorkspaceButtonController = WorkspaceButtonController-  { button :: Gtk.EventBox,-    buttonWorkspace :: Workspace,-    contentsController :: WWC-  }--buildButtonController :: ParentControllerConstructor-buildButtonController contentsBuilder workspace = do-  cc <- contentsBuilder workspace-  workspacesRef <- asks workspacesVar-  ctx <- ask-  widget <- getWidget cc-  lift $ do-    ebox <- Gtk.eventBoxNew-    Gtk.containerAdd ebox widget-    Gtk.eventBoxSetVisibleWindow ebox False-    _ <--      Gtk.onWidgetScrollEvent ebox $ \scrollEvent -> do-        dir <- Gdk.getEventScrollDirection scrollEvent-        workspaces <- liftIO $ MV.readMVar workspacesRef-        let switchOne a =-              liftIO $-                flip runReaderT ctx $-                  liftX11Def-                    ()-                    (switchOneWorkspace a (length (M.toList workspaces) - 1))-                    >> return True-        case dir of-          Gdk.ScrollDirectionUp -> switchOne True-          Gdk.ScrollDirectionLeft -> switchOne True-          Gdk.ScrollDirectionDown -> switchOne False-          Gdk.ScrollDirectionRight -> switchOne False-          _ -> return False-    _ <- Gtk.onWidgetButtonPressEvent ebox $ const $ switch ctx $ workspaceIdx workspace-    return $-      WWC-        WorkspaceButtonController-          { button = ebox,-            buttonWorkspace = workspace,-            contentsController = cc-          }--switch :: (MonadIO m) => WorkspacesContext -> WorkspaceId -> m Bool-switch ctx idx = do-  liftIO $ flip runReaderT ctx $ liftX11Def () $ switchToWorkspace idx-  return True--instance WorkspaceWidgetController WorkspaceButtonController where-  getWidget wbc = lift $ Gtk.toWidget $ button wbc-  updateWidget wbc update = do-    newContents <- updateWidget (contentsController wbc) update-    return wbc {contentsController = newContents}

@@ -1,171 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# OPTIONS_GHC -Wno-deprecations #-}------------------------------------------------------------------------------------------------------------------------------------------------------------------ |--- Module      : System.Taffybar.Widget.Workspaces.EWMH.Compat--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable------ Flat legacy compatibility config for EWMH workspaces.------ This module is intentionally not re-exported by the umbrella widget--- modules so that consumers opt in explicitly.-module System.Taffybar.Widget.Workspaces.EWMH.Compat-  ( WorkspacesConfig (..),-    defaultWorkspacesConfig,-    workspacesNew,-    workspacesCommonConfig,-    modifyCommonWorkspacesConfig,-    applyCommonWorkspacesConfig,-    toEWMHWorkspacesConfig,-    fromEWMHWorkspacesConfig,-    FlatWorkspacesConfig,-    defaultFlatWorkspacesConfig,-    fromFlatWorkspacesConfig,-    toFlatWorkspacesConfig,-  )-where--import Control.Monad.Trans.Reader (ReaderT)-import Data.Default (Default (..))-import qualified GI.Gtk as Gtk-import System.Taffybar.Context (TaffyIO)-import System.Taffybar.Widget.Workspaces.Config-  ( WorkspaceWidgetCommonConfig (WorkspaceWidgetCommonConfig),-  )-import qualified System.Taffybar.Widget.Workspaces.Config as WorkspaceConfig-import qualified System.Taffybar.Widget.Workspaces.EWMH as EWMH--data WorkspacesConfig-  = WorkspacesConfig-  { widgetBuilder :: EWMH.ControllerConstructor,-    widgetGap :: Int,-    maxIcons :: Maybe Int,-    minIcons :: Int,-    getWindowIconPixbuf :: EWMH.WindowIconPixbufGetter,-    labelSetter :: EWMH.Workspace -> EWMH.WorkspacesIO String,-    showWorkspaceFn :: EWMH.Workspace -> Bool,-    borderWidth :: Int,-    updateEvents :: [String],-    updateRateLimitMicroseconds :: Integer,-    iconSort :: [EWMH.WindowData] -> EWMH.WorkspacesIO [EWMH.WindowData],-    urgentWorkspaceState :: Bool-  }--{-# DEPRECATED widgetBuilder "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--{-# DEPRECATED widgetGap "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--{-# DEPRECATED maxIcons "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--{-# DEPRECATED minIcons "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--{-# DEPRECATED getWindowIconPixbuf "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--{-# DEPRECATED labelSetter "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--{-# DEPRECATED showWorkspaceFn "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--{-# DEPRECATED borderWidth "Legacy flat config field. Use `System.Taffybar.Widget.Workspaces.EWMH.borderWidth` on the canonical EWMH config type instead." #-}--{-# DEPRECATED updateEvents "Legacy flat config field. Use `System.Taffybar.Widget.Workspaces.EWMH.updateEvents` on the canonical EWMH config type instead." #-}--{-# DEPRECATED updateRateLimitMicroseconds "Legacy flat config field. Use `System.Taffybar.Widget.Workspaces.EWMH.updateRateLimitMicroseconds` on the canonical EWMH config type instead." #-}--{-# DEPRECATED iconSort "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--{-# DEPRECATED urgentWorkspaceState "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.EWMH.WorkspacesConfig` instead." #-}--toEWMHWorkspacesConfig :: WorkspacesConfig -> EWMH.WorkspacesConfig-toEWMHWorkspacesConfig flat =-  EWMH.WorkspacesConfig-    { EWMH.workspacesConfig =-        WorkspaceWidgetCommonConfig-          { WorkspaceConfig.widgetBuilder = widgetBuilder flat,-            WorkspaceConfig.widgetGap = widgetGap flat,-            WorkspaceConfig.maxIcons = maxIcons flat,-            WorkspaceConfig.minIcons = minIcons flat,-            WorkspaceConfig.getWindowIconPixbuf = getWindowIconPixbuf flat,-            WorkspaceConfig.labelSetter = labelSetter flat,-            WorkspaceConfig.showWorkspaceFn = showWorkspaceFn flat,-            WorkspaceConfig.iconSort = iconSort flat,-            WorkspaceConfig.urgentWorkspaceState = urgentWorkspaceState flat-          },-      EWMH.borderWidth = borderWidth flat,-      EWMH.updateEvents = updateEvents flat,-      EWMH.updateRateLimitMicroseconds = updateRateLimitMicroseconds flat-    }--fromEWMHWorkspacesConfig :: EWMH.WorkspacesConfig -> WorkspacesConfig-fromEWMHWorkspacesConfig cfg =-  let common = EWMH.workspacesConfig cfg-   in WorkspacesConfig-        { widgetBuilder = WorkspaceConfig.widgetBuilder common,-          widgetGap = WorkspaceConfig.widgetGap common,-          maxIcons = WorkspaceConfig.maxIcons common,-          minIcons = WorkspaceConfig.minIcons common,-          getWindowIconPixbuf = WorkspaceConfig.getWindowIconPixbuf common,-          labelSetter = WorkspaceConfig.labelSetter common,-          showWorkspaceFn = WorkspaceConfig.showWorkspaceFn common,-          borderWidth = EWMH.borderWidth cfg,-          updateEvents = EWMH.updateEvents cfg,-          updateRateLimitMicroseconds = EWMH.updateRateLimitMicroseconds cfg,-          iconSort = WorkspaceConfig.iconSort common,-          urgentWorkspaceState = WorkspaceConfig.urgentWorkspaceState common-        }--defaultWorkspacesConfig :: WorkspacesConfig-defaultWorkspacesConfig =-  fromEWMHWorkspacesConfig EWMH.defaultWorkspacesConfig--workspacesNew :: WorkspacesConfig -> TaffyIO Gtk.Widget-workspacesNew = EWMH.workspacesNew . toEWMHWorkspacesConfig--workspacesCommonConfig ::-  WorkspacesConfig ->-  WorkspaceWidgetCommonConfig (ReaderT EWMH.WorkspacesContext IO) EWMH.Workspace EWMH.WindowData EWMH.WWC-workspacesCommonConfig =-  EWMH.workspacesConfig . toEWMHWorkspacesConfig---- | Modify the nested common config inside a legacy flat workspaces config.------ Prefer this over defining @common@ in terms of a recursively-defined @cfg@,--- which can accidentally create a black-hole and hang at runtime.-modifyCommonWorkspacesConfig ::-  ( WorkspaceWidgetCommonConfig (ReaderT EWMH.WorkspacesContext IO) EWMH.Workspace EWMH.WindowData EWMH.WWC ->-    WorkspaceWidgetCommonConfig (ReaderT EWMH.WorkspacesContext IO) EWMH.Workspace EWMH.WindowData EWMH.WWC-  ) ->-  WorkspacesConfig ->-  WorkspacesConfig-modifyCommonWorkspacesConfig f cfg =-  applyCommonWorkspacesConfig (f (workspacesCommonConfig cfg)) cfg--applyCommonWorkspacesConfig ::-  WorkspaceWidgetCommonConfig (ReaderT EWMH.WorkspacesContext IO) EWMH.Workspace EWMH.WindowData EWMH.WWC ->-  WorkspacesConfig ->-  WorkspacesConfig-applyCommonWorkspacesConfig common cfg =-  fromEWMHWorkspacesConfig $-    EWMH.applyCommonWorkspacesConfig common (toEWMHWorkspacesConfig cfg)--type FlatWorkspacesConfig = WorkspacesConfig--defaultFlatWorkspacesConfig :: FlatWorkspacesConfig-defaultFlatWorkspacesConfig = defaultWorkspacesConfig--fromFlatWorkspacesConfig :: FlatWorkspacesConfig -> EWMH.WorkspacesConfig-fromFlatWorkspacesConfig = toEWMHWorkspacesConfig--toFlatWorkspacesConfig :: EWMH.WorkspacesConfig -> FlatWorkspacesConfig-toFlatWorkspacesConfig = fromEWMHWorkspacesConfig--instance Default WorkspacesConfig where-  def = defaultWorkspacesConfig

@@ -1,963 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE OverloadedStrings #-}------------------------------------------------------------------------------------------------------------------------------------------------------------------ |--- Module      : System.Taffybar.Widget.Workspaces.Hyprland--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable------ Hyprland workspaces widget backed by hyprctl.-module System.Taffybar.Widget.Workspaces.Hyprland where--import Control.Applicative ((<|>))-import Control.Concurrent (forkIO, killThread)-import Control.Concurrent.STM.TChan (TChan, readTChan)-import Control.Monad (foldM, forM_, when)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Control.Monad.STM (atomically)-import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)-import Data.Aeson (FromJSON (..), withObject, (.!=), (.:), (.:?))-import qualified Data.ByteString as BS-import Data.Char (toLower)-import Data.Default (Default (..))-import qualified Data.Foldable as F-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.Int (Int32)-import Data.List (intercalate, sortOn, stripPrefix)-import qualified Data.Map.Strict as M-import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)-import qualified Data.MultiMap as MM-import Data.Text (Text)-import qualified Data.Text as T-import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk-import qualified GI.Gtk as Gtk-import System.Environment.XDG.DesktopEntry-  ( DesktopEntry,-    deFilename,-    getDirectoryEntriesDefault,-  )-import System.Log.Logger (Priority (..), logM)-import System.Taffybar.Context-import System.Taffybar.Hyprland-  ( getHyprlandEventChan,-    runHyprlandCommandJsonT,-    runHyprlandCommandRawT,-  )-import qualified System.Taffybar.Information.Hyprland as Hypr-import System.Taffybar.Util-import System.Taffybar.Widget.Generic.ScalingImage (getScalingImageStrategy)-import System.Taffybar.Widget.Util-  ( WindowIconWidget (..),-    computeIconStripLayout,-    getImageForDesktopEntry,-    handlePixbufGetterException,-    scaledPixbufGetter,-    syncWidgetPool,-    updateWindowIconWidgetState,-    widgetSetClassGI,-    windowStatusClassFromFlags,-  )-import System.Taffybar.Widget.Workspaces.Config-  ( WorkspaceWidgetCommonConfig (WorkspaceWidgetCommonConfig),-  )-import qualified System.Taffybar.Widget.Workspaces.Config as WorkspaceWidgetConfig-import System.Taffybar.Widget.Workspaces.Shared-  ( WorkspaceState (..),-    buildWorkspaceIconLabelOverlay,-    mkWorkspaceIconWidget,-    setWorkspaceWidgetStatusClass,-  )-import System.Taffybar.WindowIcon (getCachedWindowIconFromClasses, pixBufFromColor)-import Text.Printf (printf)--stripSuffix :: (Eq a) => [a] -> [a] -> Maybe [a]-stripSuffix suffix value =-  reverse <$> stripPrefix (reverse suffix) (reverse value)--isSpecialHyprWorkspace :: HyprlandWorkspace -> Bool-isSpecialHyprWorkspace ws =-  let name = T.toLower $ T.pack $ workspaceName ws-   in T.isPrefixOf "special" name || workspaceIdx ws < 0--data HyprlandWindow = HyprlandWindow-  { windowAddress :: Text,-    windowTitle :: String,-    windowClass :: Maybe String,-    windowInitialClass :: Maybe String,-    -- | The top-left position (x, y) of the window, as reported by-    -- @hyprctl clients -j@. This is used for optional icon ordering.-    windowAt :: Maybe (Int, Int),-    windowUrgent :: Bool,-    windowActive :: Bool,-    windowMinimized :: Bool-  }-  deriving (Show, Eq)--data HyprlandWorkspace = HyprlandWorkspace-  { workspaceIdx :: Int,-    workspaceName :: String,-    workspaceState :: WorkspaceState,-    windows :: [HyprlandWindow]-  }-  deriving (Show, Eq)--newtype HyprlandWorkspaceCache = HyprlandWorkspaceCache [HyprlandWorkspace]--newtype HyprlandWorkspaceWidgetCache-  = HyprlandWorkspaceWidgetCache (M.Map Int HyprlandWorkspaceEntry)--newtype HyprlandWorkspaceOrderCache-  = HyprlandWorkspaceOrderCache [Int]--data HyprlandWorkspaceEntry = HyprlandWorkspaceEntry-  { hweWrapper :: Gtk.Widget,-    hweController :: HyprlandWWC,-    hweLast :: HyprlandWorkspace-  }--type HyprlandIconWidget = WindowIconWidget HyprlandWindow---- | Controller typeclass for Hyprland workspace widgets, mirroring--- the X11 'WorkspaceWidgetController' pattern.-class HyprlandWorkspaceWidgetController wc where-  hwcGetWidget :: wc -> IO Gtk.Widget-  hwcUpdateWidget :: wc -> HyprlandWorkspace -> TaffyIO wc---- | Existential wrapper for Hyprland workspace controllers.-data HyprlandWWC = forall a. (HyprlandWorkspaceWidgetController a) => HyprlandWWC a--instance HyprlandWorkspaceWidgetController HyprlandWWC where-  hwcGetWidget (HyprlandWWC wc) = hwcGetWidget wc-  hwcUpdateWidget (HyprlandWWC wc) ws = HyprlandWWC <$> hwcUpdateWidget wc ws--type HyprlandControllerConstructor = HyprlandWorkspace -> TaffyIO HyprlandWWC--type HyprlandParentControllerConstructor =-  HyprlandControllerConstructor -> HyprlandControllerConstructor--type HyprlandWindowIconPixbufGetter =-  Int32 -> HyprlandWindow -> TaffyIO (Maybe Gdk.Pixbuf)--data HyprlandWorkspacesConfig-  = HyprlandWorkspacesConfig-  { getWorkspaces :: TaffyIO [HyprlandWorkspace],-    switchToWorkspace :: HyprlandWorkspace -> TaffyIO (),-    updateIntervalSeconds :: Double,-    iconSize :: Int32,-    workspacesConfig ::-      WorkspaceWidgetCommonConfig-        (ReaderT Context IO)-        HyprlandWorkspace-        HyprlandWindow-        HyprlandWWC-  }--hyprlandWorkspacesCommonConfig ::-  HyprlandWorkspacesConfig ->-  WorkspaceWidgetCommonConfig (ReaderT Context IO) HyprlandWorkspace HyprlandWindow HyprlandWWC-hyprlandWorkspacesCommonConfig = workspacesConfig---- | Modify the nested 'WorkspaceWidgetCommonConfig' inside a--- 'HyprlandWorkspacesConfig'.------ This helper exists to avoid accidental self-recursive config definitions--- when overriding multiple fields. Prefer:------ > cfg = modifyCommonHyprlandWorkspacesConfig (\c -> c { WorkspaceWidgetConfig.minIcons = 1 }) defaultHyprlandWorkspacesConfig------ over tying the knot yourself (e.g. defining @common@ in terms of @cfg@ while--- also defining @cfg@ in terms of @common@), which can hang at runtime.-modifyCommonHyprlandWorkspacesConfig ::-  ( WorkspaceWidgetCommonConfig (ReaderT Context IO) HyprlandWorkspace HyprlandWindow HyprlandWWC ->-    WorkspaceWidgetCommonConfig (ReaderT Context IO) HyprlandWorkspace HyprlandWindow HyprlandWWC-  ) ->-  HyprlandWorkspacesConfig ->-  HyprlandWorkspacesConfig-modifyCommonHyprlandWorkspacesConfig f cfg =-  cfg {workspacesConfig = f (workspacesConfig cfg)}---- | Replace the nested common config inside 'HyprlandWorkspacesConfig'.------ If you're just tweaking a few fields, prefer--- 'modifyCommonHyprlandWorkspacesConfig' to avoid accidentally creating a--- self-recursive definition that can hang at runtime.-applyCommonHyprlandWorkspacesConfig ::-  WorkspaceWidgetCommonConfig (ReaderT Context IO) HyprlandWorkspace HyprlandWindow HyprlandWWC ->-  HyprlandWorkspacesConfig ->-  HyprlandWorkspacesConfig-applyCommonHyprlandWorkspacesConfig common cfg =-  cfg {workspacesConfig = common}--defaultHyprlandWorkspacesConfig :: HyprlandWorkspacesConfig-defaultHyprlandWorkspacesConfig = cfg-  where-    cfg =-      HyprlandWorkspacesConfig-        { getWorkspaces = getHyprlandWorkspaces,-          switchToWorkspace = hyprlandSwitchToWorkspace,-          updateIntervalSeconds = 1,-          iconSize = 16,-          workspacesConfig =-            WorkspaceWidgetCommonConfig-              { WorkspaceWidgetConfig.widgetBuilder = defaultHyprlandWidgetBuilder cfg,-                WorkspaceWidgetConfig.widgetGap = 0,-                WorkspaceWidgetConfig.maxIcons = Nothing,-                WorkspaceWidgetConfig.minIcons = 0,-                WorkspaceWidgetConfig.getWindowIconPixbuf = defaultHyprlandGetWindowIconPixbuf,-                WorkspaceWidgetConfig.labelSetter = return . workspaceName,-                WorkspaceWidgetConfig.showWorkspaceFn = \ws ->-                  workspaceState ws /= Empty && not (isSpecialHyprWorkspace ws),-                -- Match the X11 Workspaces widget default: order icons by window position.-                WorkspaceWidgetConfig.iconSort = pure . sortHyprlandWindowsByPosition,-                WorkspaceWidgetConfig.urgentWorkspaceState = False-              }-        }--instance Default HyprlandWorkspacesConfig where-  def = defaultHyprlandWorkspacesConfig--hyprlandWorkspacesNew :: HyprlandWorkspacesConfig -> TaffyIO Gtk.Widget-hyprlandWorkspacesNew cfg = do-  let common = hyprlandWorkspacesCommonConfig cfg-  cont <--    liftIO $-      Gtk.boxNew Gtk.OrientationHorizontal $-        fromIntegral (WorkspaceWidgetConfig.widgetGap common)-  _ <- widgetSetClassGI cont "workspaces"-  ctx <- ask-  let refresh = runReaderT (refreshWorkspaces cfg cont) ctx-  liftIO refresh-  -- Ensure this top-level container is visible when packed into the bar.-  -- Otherwise the start widget area can appear blank under Wayland/Hyprland.-  liftIO $ Gtk.widgetShowAll cont-  eventChan <- getHyprlandEventChan-  events <- liftIO $ Hypr.subscribeHyprlandEvents eventChan-  tid <- liftIO $ forkIO $ hyprlandUpdateLoop refresh events-  _ <- liftIO $ Gtk.onWidgetUnrealize cont $ killThread tid-  Gtk.toWidget cont--hyprlandUpdateLoop :: IO () -> TChan T.Text -> IO ()-hyprlandUpdateLoop refresh events = do-  line <- atomically $ readTChan events-  when (isRelevantHyprEvent (T.unpack line)) refresh-  hyprlandUpdateLoop refresh events--isRelevantHyprEvent :: String -> Bool-isRelevantHyprEvent line =-  let eventName = takeWhile (/= '>') line-   in eventName-        `elem` [ "workspace",-                 "workspacev2",-                 "focusedmon",-                 "activewindow",-                 "activewindowv2",-                 "openwindow",-                 "closewindow",-                 "movewindow",-                 "movewindowv2",-                 "moveworkspace",-                 "renameworkspace",-                 "createworkspace",-                 "destroyworkspace",-                 "monitoradded",-                 "monitorremoved",-                 -- Synthetic "event" emitted by our event reader thread whenever it-                 -- (re)connects to Hyprland. This lets us refresh after a compositor-                 -- restart without polling.-                 "taffybar-hyprland-connected"-               ]--refreshWorkspaces :: HyprlandWorkspacesConfig -> Gtk.Box -> ReaderT Context IO ()-refreshWorkspaces cfg cont = do-  let common = hyprlandWorkspacesCommonConfig cfg-  ws <- getWorkspaces cfg-  HyprlandWorkspaceCache prev <- getStateDefault $ return (HyprlandWorkspaceCache [])-  -- Detect whether the cached widgets have been orphaned (e.g. the bar window-  -- was destroyed and recreated after a compositor reload).  When the old GTK-  -- objects are gone we must re-render even if the workspace data is unchanged.-  HyprlandWorkspaceWidgetCache wc <--    getStateDefault $ return (HyprlandWorkspaceWidgetCache M.empty)-  widgetsStale <- case M.elems wc of-    [] -> return False-    (first : _) -> liftIO $ not <$> Gtk.widgetGetRealized (hweWrapper first)-  let ignoreEmptyResult = null ws && not (null prev)-  when ignoreEmptyResult $-    liftIO $-      wLog WARNING $-        printf-          "Hyprland workspaces refresh returned empty list; retaining previous state (prevTotal=%d)."-          (length prev)-  let needsRender = (ws /= prev || widgetsStale) && not ignoreEmptyResult-  when needsRender $ do-    liftIO $-      wLog DEBUG $-        printf-          "Hyprland workspaces refresh: total=%d shown=%d (minIcons=%d maxIcons=%s) widgetsStale=%s %s"-          (length ws)-          (length (filter (WorkspaceWidgetConfig.showWorkspaceFn common) ws))-          (WorkspaceWidgetConfig.minIcons common)-          (show (WorkspaceWidgetConfig.maxIcons common))-          (show widgetsStale)-          (summarizeWorkspaces ws)-    _ <- setState (HyprlandWorkspaceCache ws)-    ctx <- ask-    liftIO $ postGUIASync $ runReaderT (renderWorkspaces cfg cont ws) ctx--renderWorkspaces ::-  HyprlandWorkspacesConfig -> Gtk.Box -> [HyprlandWorkspace] -> ReaderT Context IO ()-renderWorkspaces cfg cont workspaces = do-  let common = hyprlandWorkspacesCommonConfig cfg-  let workspaces' = map (applyUrgentState cfg) workspaces-  HyprlandWorkspaceWidgetCache widgetCache <--    getStateDefault $ return (HyprlandWorkspaceWidgetCache M.empty)-  HyprlandWorkspaceOrderCache prevOrder <--    getStateDefault $ return (HyprlandWorkspaceOrderCache [])-  -- If any cached widget has been unrealized (e.g. because the bar window was-  -- recreated after a compositor reload), the old GTK objects are dead and must-  -- be discarded so that fresh widgets are built for the new container.-  stale <- case M.elems widgetCache of-    [] -> return False-    (first : _) -> liftIO $ not <$> Gtk.widgetGetRealized (hweWrapper first)-  let oldCache = if stale then M.empty else widgetCache-      oldOrder = if stale then [] else prevOrder-  when stale $-    liftIO $-      wLog DEBUG "renderWorkspaces: discarding stale widget cache (widgets unrealized)"-  let buildOrUpdate newCache ws = do-        let idx = workspaceIdx ws-        entry <- case M.lookup idx oldCache of-          Just prevEntry-            | hweLast prevEntry == ws -> return prevEntry-            | otherwise -> do-                newCtrl <- hwcUpdateWidget (hweController prevEntry) ws-                return prevEntry {hweController = newCtrl, hweLast = ws}-          Nothing -> do-            ctrl <- WorkspaceWidgetConfig.widgetBuilder common ws-            ctrlWidget <- liftIO $ hwcGetWidget ctrl-            wrapperBox <- liftIO $ Gtk.boxNew Gtk.OrientationHorizontal 0-            liftIO $ Gtk.containerAdd wrapperBox ctrlWidget-            wrapper <- Gtk.toWidget wrapperBox-            return-              HyprlandWorkspaceEntry-                { hweWrapper = wrapper,-                  hweController = ctrl,-                  hweLast = ws-                }-        return (M.insert idx entry newCache, entry)--  (newCache, orderedEntriesRev) <--    foldM-      ( \(cacheAcc, entriesAcc) ws -> do-          (cacheAcc', entry) <- buildOrUpdate cacheAcc ws-          return (cacheAcc', (ws, entry) : entriesAcc)-      )-      (M.empty, [])-      workspaces'-  let orderedEntries = reverse orderedEntriesRev--  let primaryShowFn = WorkspaceWidgetConfig.showWorkspaceFn common-      primaryShownCount = length $ filter (primaryShowFn . fst) orderedEntries-      fallbackShowFn ws = workspaceState ws /= Empty-      fallbackShownCount = length $ filter (fallbackShowFn . fst) orderedEntries-      (finalShowFn, finalShownCount, fallbackUsed) =-        if primaryShownCount == 0 && fallbackShownCount > 0-          then (fallbackShowFn, fallbackShownCount, True)-          else (primaryShowFn, primaryShownCount, False)--  when (fallbackUsed && not (null orderedEntries)) $-    liftIO $-      wLog WARNING $-        printf-          "Hyprland workspaces: showWorkspaceFn hid all %d workspaces; falling back to showing non-empty workspaces (including special:*). %s"-          (length orderedEntries)-          (summarizeWorkspaces (map fst orderedEntries))-  when (finalShownCount == 0 && not (null orderedEntries)) $-    liftIO $-      wLog WARNING $-        printf-          "Hyprland workspaces widget is blank: no workspaces passed the show filter (total=%d). %s"-          (length orderedEntries)-          (summarizeWorkspaces (map fst orderedEntries))--  -- Remove wrappers for workspaces that disappeared.-  let removed = M.difference oldCache newCache-  forM_ (M.elems removed) $ \entry ->-    liftIO $ Gtk.containerRemove cont (hweWrapper entry)--  -- Add wrappers for newly created workspaces.-  let added = M.difference newCache oldCache-  forM_ (M.elems added) $ \entry -> do-    liftIO $ Gtk.containerAdd cont (hweWrapper entry)-    liftIO $ Gtk.widgetShowAll (hweWrapper entry)--  let desiredOrder = map (workspaceIdx . fst) orderedEntries-      needsReorder =-        desiredOrder /= oldOrder || not (M.null added) || not (M.null removed)-  when needsReorder $ do-    -- Reorder wrappers to match the order returned by hyprctl.-    forM_ (zip [0 :: Int ..] orderedEntries) $ \(pos, (_ws, entry)) ->-      liftIO $ Gtk.boxReorderChild cont (hweWrapper entry) (fromIntegral pos)--  -- Show/hide the controller widget without removing the wrapper from the box.-  forM_ orderedEntries $ \(ws, entry) -> do-    ctrlWidget <- liftIO $ hwcGetWidget (hweController entry)-    if finalShowFn ws-      then liftIO $ Gtk.widgetShow ctrlWidget-      else liftIO $ Gtk.widgetHide ctrlWidget--  _ <- setState (HyprlandWorkspaceWidgetCache newCache)-  _ <- setState (HyprlandWorkspaceOrderCache desiredOrder)-  return ()--summarizeWorkspaces :: [HyprlandWorkspace] -> String-summarizeWorkspaces wss =-  let summarizeOne ws =-        printf-          "%d:%s:%s(wins=%d)"-          (workspaceIdx ws)-          (workspaceName ws)-          (show (workspaceState ws))-          (length (windows ws))-      maxShown = 12-      body = intercalate ", " $ map summarizeOne (take maxShown wss)-      suffix = if length wss > maxShown then ", ..." else ""-   in "workspaces=[" ++ body ++ suffix ++ "]"--applyUrgentState :: HyprlandWorkspacesConfig -> HyprlandWorkspace -> HyprlandWorkspace-applyUrgentState cfg ws-  | WorkspaceWidgetConfig.urgentWorkspaceState (hyprlandWorkspacesCommonConfig cfg)-      && workspaceState ws == Hidden-      && any windowUrgent (windows ws) =-      ws {workspaceState = Urgent}-  | otherwise = ws---- Controller types--data HyprlandLabelController = HyprlandLabelController-  { hlcLabel :: Gtk.Label,-    hlcLabelSetter :: HyprlandWorkspace -> TaffyIO String-  }--instance HyprlandWorkspaceWidgetController HyprlandLabelController where-  hwcGetWidget = Gtk.toWidget . hlcLabel-  hwcUpdateWidget lc ws = do-    labelText <- hlcLabelSetter lc ws-    liftIO $ do-      Gtk.labelSetMarkup (hlcLabel lc) (T.pack labelText)-      setWorkspaceWidgetStatusClass (workspaceState ws) (hlcLabel lc)-    return lc--hyprlandBuildLabelController :: HyprlandWorkspacesConfig -> HyprlandControllerConstructor-hyprlandBuildLabelController cfg ws = do-  let common = hyprlandWorkspacesCommonConfig cfg-  lbl <- liftIO $ Gtk.labelNew Nothing-  _ <- widgetSetClassGI lbl "workspace-label"-  labelText <- WorkspaceWidgetConfig.labelSetter common ws-  liftIO $ Gtk.labelSetMarkup lbl (T.pack labelText)-  liftIO $ setWorkspaceWidgetStatusClass (workspaceState ws) lbl-  return $-    HyprlandWWC $-      HyprlandLabelController-        { hlcLabel = lbl,-          hlcLabelSetter = WorkspaceWidgetConfig.labelSetter common-        }--data HyprlandIconController = HyprlandIconController-  { hicIconsContainer :: Gtk.Box,-    hicIconImages :: [HyprlandIconWidget],-    hicWorkspace :: HyprlandWorkspace,-    hicConfig :: HyprlandWorkspacesConfig-  }--instance HyprlandWorkspaceWidgetController HyprlandIconController where-  hwcGetWidget = Gtk.toWidget . hicIconsContainer-  hwcUpdateWidget ic ws = do-    newImages <--      if windows ws /= windows (hicWorkspace ic)-        then updateIcons (hicConfig ic) ws (hicIconsContainer ic) (hicIconImages ic)-        else return (hicIconImages ic)-    return ic {hicIconImages = newImages, hicWorkspace = ws}--hyprlandBuildIconController :: HyprlandWorkspacesConfig -> HyprlandControllerConstructor-hyprlandBuildIconController cfg ws = do-  iconsBox <- liftIO $ Gtk.boxNew Gtk.OrientationHorizontal 0-  icons <- updateIcons cfg ws iconsBox []-  return $-    HyprlandWWC $-      HyprlandIconController-        { hicIconsContainer = iconsBox,-          hicIconImages = icons,-          hicWorkspace = ws,-          hicConfig = cfg-        }--data HyprlandContentsController = HyprlandContentsController-  { hccContainerWidget :: Gtk.Widget,-    hccControllers :: [HyprlandWWC]-  }--instance HyprlandWorkspaceWidgetController HyprlandContentsController where-  hwcGetWidget = return . hccContainerWidget-  hwcUpdateWidget cc ws = do-    liftIO $ setWorkspaceWidgetStatusClass (workspaceState ws) (hccContainerWidget cc)-    newControllers <- mapM (`hwcUpdateWidget` ws) (hccControllers cc)-    return cc {hccControllers = newControllers}--hyprlandBuildContentsController ::-  [HyprlandControllerConstructor] -> HyprlandControllerConstructor-hyprlandBuildContentsController constructors ws = do-  controllers <- mapM ($ ws) constructors-  widgets <- liftIO $ mapM hwcGetWidget controllers-  widget <- liftIO $ do-    cons <- Gtk.boxNew Gtk.OrientationHorizontal 0-    mapM_ (Gtk.containerAdd cons) widgets-    _ <- widgetSetClassGI cons "contents"-    Gtk.toWidget cons-  liftIO $ setWorkspaceWidgetStatusClass (workspaceState ws) widget-  return $-    HyprlandWWC $-      HyprlandContentsController-        { hccContainerWidget = widget,-          hccControllers = controllers-        }--hyprlandBuildLabelOverlayController ::-  HyprlandWorkspacesConfig -> HyprlandControllerConstructor-hyprlandBuildLabelOverlayController cfg ws = do-  iconCtrl <- hyprlandBuildIconController cfg ws-  labelCtrl <- hyprlandBuildLabelController cfg ws-  iconWidget <- liftIO $ hwcGetWidget iconCtrl-  labelWidget <- liftIO $ hwcGetWidget labelCtrl-  widget <- buildWorkspaceIconLabelOverlay iconWidget labelWidget-  liftIO $ setWorkspaceWidgetStatusClass (workspaceState ws) widget-  return $-    HyprlandWWC $-      HyprlandContentsController-        { hccContainerWidget = widget,-          hccControllers = [iconCtrl, labelCtrl]-        }---- | Like 'hyprlandBuildLabelOverlayController' but accepts a custom function--- to combine the icon and label widgets into a single container widget.-hyprlandBuildCustomOverlayController ::-  (Gtk.Widget -> Gtk.Widget -> TaffyIO Gtk.Widget) ->-  HyprlandWorkspacesConfig ->-  HyprlandControllerConstructor-hyprlandBuildCustomOverlayController combiner cfg ws = do-  iconCtrl <- hyprlandBuildIconController cfg ws-  labelCtrl <- hyprlandBuildLabelController cfg ws-  iconWidget <- liftIO $ hwcGetWidget iconCtrl-  labelWidget <- liftIO $ hwcGetWidget labelCtrl-  widget <- combiner iconWidget labelWidget-  liftIO $ setWorkspaceWidgetStatusClass (workspaceState ws) widget-  return $-    HyprlandWWC $-      HyprlandContentsController-        { hccContainerWidget = widget,-          hccControllers = [iconCtrl, labelCtrl]-        }--hyprlandDefaultBuildContentsController ::-  HyprlandWorkspacesConfig -> HyprlandControllerConstructor-hyprlandDefaultBuildContentsController = hyprlandBuildLabelOverlayController--data HyprlandButtonController = HyprlandButtonController-  { hbcButton :: Gtk.EventBox,-    hbcWorkspaceRef :: IORef HyprlandWorkspace,-    hbcContentsController :: HyprlandWWC-  }--instance HyprlandWorkspaceWidgetController HyprlandButtonController where-  hwcGetWidget = Gtk.toWidget . hbcButton-  hwcUpdateWidget wbc ws = do-    liftIO $ writeIORef (hbcWorkspaceRef wbc) ws-    newContents <- hwcUpdateWidget (hbcContentsController wbc) ws-    return wbc {hbcContentsController = newContents}--hyprlandBuildButtonController ::-  HyprlandWorkspacesConfig -> HyprlandParentControllerConstructor-hyprlandBuildButtonController cfg contentsBuilder ws = do-  cc <- contentsBuilder ws-  ctx <- ask-  contentsWidget <- liftIO $ hwcGetWidget cc-  wsRef <- liftIO $ newIORef ws-  ebox <- liftIO $ do-    eb <- Gtk.eventBoxNew-    Gtk.eventBoxSetVisibleWindow eb False-    Gtk.containerAdd eb contentsWidget-    _ <- Gtk.onWidgetButtonPressEvent eb $ const $ do-      wsCurrent <- readIORef wsRef-      runReaderT (switchToWorkspace cfg wsCurrent) ctx-      return True-    return eb-  return $-    HyprlandWWC $-      HyprlandButtonController-        { hbcButton = ebox,-          hbcWorkspaceRef = wsRef,-          hbcContentsController = cc-        }--defaultHyprlandWidgetBuilder :: HyprlandWorkspacesConfig -> HyprlandControllerConstructor-defaultHyprlandWidgetBuilder cfg =-  hyprlandBuildButtonController cfg (hyprlandDefaultBuildContentsController cfg)--updateIcons ::-  HyprlandWorkspacesConfig ->-  HyprlandWorkspace ->-  Gtk.Box ->-  [HyprlandIconWidget] ->-  ReaderT Context IO [HyprlandIconWidget]-updateIcons cfg ws iconsBox iconWidgets = do-  let common = hyprlandWorkspacesCommonConfig cfg-  sortedWindows <- WorkspaceWidgetConfig.iconSort common $ windows ws-  let (effectiveMinIcons, _targetLen, paddedWindows) =-        computeIconStripLayout-          (WorkspaceWidgetConfig.minIcons common)-          (WorkspaceWidgetConfig.maxIcons common)-          sortedWindows-      buildOne i = buildIconWidget (i < effectiveMinIcons) cfg-  syncWidgetPool iconsBox iconWidgets paddedWindows buildOne iconContainer updateIconWidget--buildIconWidget :: Bool -> HyprlandWorkspacesConfig -> ReaderT Context IO HyprlandIconWidget-buildIconWidget transparentOnNone cfg = do-  ctx <- ask-  let common = hyprlandWorkspacesCommonConfig cfg-  strategy <- getScalingImageStrategy-  liftIO $-    mkWorkspaceIconWidget-      strategy-      (Just $ iconSize cfg)-      transparentOnNone-      (\size w -> runReaderT (WorkspaceWidgetConfig.getWindowIconPixbuf common size w) ctx)-      (`pixBufFromColor` 0)--updateIconWidget :: HyprlandIconWidget -> Maybe HyprlandWindow -> ReaderT Context IO ()-updateIconWidget iconWidget windowData =-  updateWindowIconWidgetState-    iconWidget-    windowData-    (T.pack . windowTitle)-    getWindowStatusString--getWindowStatusString :: HyprlandWindow -> T.Text-getWindowStatusString windowData =-  windowStatusClassFromFlags-    (windowMinimized windowData)-    (windowActive windowData)-    (windowUrgent windowData)---- | Sort windows by their top-left corner position.------ This mirrors the X11 Workspaces widget default ('sortWindowsByPosition'),--- but uses Hyprland's @at@ coordinate from @hyprctl clients -j@.-sortHyprlandWindowsByPosition :: [HyprlandWindow] -> [HyprlandWindow]-sortHyprlandWindowsByPosition =-  sortOn $ \w ->-    ( windowMinimized w,-      fromMaybe (999999999, 999999999) (windowAt w)-    )--wLog :: (MonadIO m) => Priority -> String -> m ()-wLog l s = liftIO $ logM "System.Taffybar.Widget.HyprlandWorkspaces" l s---- Window icon lookup--scaledWindowIconPixbufGetter ::-  HyprlandWindowIconPixbufGetter -> HyprlandWindowIconPixbufGetter-scaledWindowIconPixbufGetter = scaledPixbufGetter--handleIconGetterException ::-  HyprlandWindowIconPixbufGetter -> HyprlandWindowIconPixbufGetter-handleIconGetterException = handlePixbufGetterException wLog--defaultHyprlandGetWindowIconPixbuf :: HyprlandWindowIconPixbufGetter-defaultHyprlandGetWindowIconPixbuf =-  scaledWindowIconPixbufGetter $-    getWindowIconPixbufFromDesktopEntry <|||> getWindowIconPixbufFromClass--getWindowIconPixbufFromClass :: HyprlandWindowIconPixbufGetter-getWindowIconPixbufFromClass size windowData =-  maybeTCombine-    (maybe (return Nothing) (getCachedWindowIconFromClasses size) (windowClass windowData))-    (maybe (return Nothing) (getCachedWindowIconFromClasses size) (windowInitialClass windowData))--getWindowIconPixbufFromDesktopEntry :: HyprlandWindowIconPixbufGetter-getWindowIconPixbufFromDesktopEntry =-  handleIconGetterException $ \size windowData ->-    maybeTCombine-      (maybe (return Nothing) (getWindowIconFromDesktopEntryByAppId size) (windowClass windowData))-      (maybe (return Nothing) (getWindowIconFromDesktopEntryByAppId size) (windowInitialClass windowData))--getDirectoryEntriesByAppId :: TaffyIO (MM.MultiMap String DesktopEntry)-getDirectoryEntriesByAppId = getStateDefault readDirectoryEntriesByAppId--readDirectoryEntriesByAppId :: TaffyIO (MM.MultiMap String DesktopEntry)-readDirectoryEntriesByAppId =-  liftIO $ indexDesktopEntriesByAppId <$> getDirectoryEntriesDefault--indexDesktopEntriesByAppId :: [DesktopEntry] -> MM.MultiMap String DesktopEntry-indexDesktopEntriesByAppId =-  F.foldl' (\m de -> MM.insert (normalizeAppId $ deFilename de) de m) MM.empty--normalizeAppId :: String -> String-normalizeAppId name =-  let stripped = fromMaybe name (stripSuffix ".desktop" name)-   in map toLower stripped--getWindowIconFromDesktopEntryByAppId ::-  Int32 -> String -> TaffyIO (Maybe Gdk.Pixbuf)-getWindowIconFromDesktopEntryByAppId size appId = do-  entries <- MM.lookup (normalizeAppId appId) <$> getDirectoryEntriesByAppId-  case entries of-    [] -> return Nothing-    (entry : _) -> do-      liftIO $-        logM "System.Taffybar.Widget.HyprlandWorkspaces" DEBUG $-          printf-            "Using desktop entry for icon %s (appId=%s)"-            (deFilename entry)-            appId-      liftIO $ getImageForDesktopEntry size entry---- Hyprland backend--data HyprlandWorkspaceRef = HyprlandWorkspaceRef-  { hwrId :: Int,-    hwrName :: Text-  }-  deriving (Show, Eq)--instance FromJSON HyprlandWorkspaceRef where-  parseJSON = withObject "HyprlandWorkspaceRef" $ \v ->-    HyprlandWorkspaceRef-      <$> v .: "id"-      <*> v .: "name"--data HyprlandWorkspaceInfo = HyprlandWorkspaceInfo-  { hwiId :: Int,-    hwiName :: Text,-    hwiWindows :: Int-  }-  deriving (Show, Eq)--instance FromJSON HyprlandWorkspaceInfo where-  parseJSON = withObject "HyprlandWorkspaceInfo" $ \v ->-    HyprlandWorkspaceInfo-      <$> v .: "id"-      <*> v .: "name"-      <*> v .:? "windows" .!= 0--data HyprlandMonitorInfo = HyprlandMonitorInfo-  { hmFocused :: Bool,-    hmActiveWorkspace :: Maybe HyprlandWorkspaceRef-  }-  deriving (Show, Eq)--instance FromJSON HyprlandMonitorInfo where-  parseJSON = withObject "HyprlandMonitorInfo" $ \v ->-    HyprlandMonitorInfo-      <$> v .:? "focused" .!= False-      <*> v .:? "activeWorkspace"--data HyprlandClient = HyprlandClient-  { hcAddress :: Text,-    hcTitle :: Text,-    hcInitialTitle :: Maybe Text,-    hcClass :: Maybe Text,-    hcInitialClass :: Maybe Text,-    hcAt :: Maybe (Int, Int),-    hcWorkspace :: HyprlandWorkspaceRef,-    hcFocused :: Bool,-    hcHidden :: Bool,-    hcMapped :: Bool,-    hcUrgent :: Bool-  }-  deriving (Show, Eq)--instance FromJSON HyprlandClient where-  parseJSON = withObject "HyprlandClient" $ \v ->-    HyprlandClient-      <$> v .: "address"-      <*> v .:? "title" .!= ""-      <*> v .:? "initialTitle"-      <*> v .:? "class"-      <*> v .:? "initialClass"-      <*> (vec2FromList <$> v .:? "at")-      <*> v .: "workspace"-      <*> v .:? "focused" .!= False-      <*> v .:? "hidden" .!= False-      <*> v .:? "mapped" .!= True-      <*> v .:? "urgent" .!= False-    where-      vec2FromList :: Maybe [Int] -> Maybe (Int, Int)-      vec2FromList (Just [x, y]) = Just (x, y)-      vec2FromList _ = Nothing--newtype HyprlandActiveWindow = HyprlandActiveWindow-  { hawAddress :: Text-  }-  deriving (Show, Eq)--instance FromJSON HyprlandActiveWindow where-  parseJSON = withObject "HyprlandActiveWindow" $ \v ->-    HyprlandActiveWindow <$> v .: "address"--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--runHyprlandCommandRaw :: [String] -> TaffyIO (Either String BS.ByteString)-runHyprlandCommandRaw args = do-  let cmd =-        case args of-          ("-j" : rest) -> Hypr.hyprCommandJson rest-          _ -> Hypr.hyprCommand args-  result <- runHyprlandCommandRawT cmd-  pure $ case result of-    Left err -> Left (show err)-    Right out -> Right out--hyprlandSwitchToWorkspace :: HyprlandWorkspace -> TaffyIO ()-hyprlandSwitchToWorkspace ws = do-  result <- runHyprlandCommandRaw ["dispatch", "workspace", workspaceName ws]-  case result of-    Left err -> wLog WARNING $ printf "Failed to switch workspace: %s" err-    Right _ -> return ()--getHyprlandWorkspaces :: TaffyIO [HyprlandWorkspace]-getHyprlandWorkspaces = do-  workspacesResult <- runHyprctlJson ["-j", "workspaces"]-  clientsResult <- runHyprctlJson ["-j", "clients"]-  monitorsResult <- runHyprctlJson ["-j", "monitors"]-  activeWorkspaceResult <- runHyprctlJson ["-j", "activeworkspace"]-  activeWindowAddress <- getActiveWindowAddress--  workspaces <- case workspacesResult of-    Left err -> wLog WARNING (printf "hyprctl workspaces failed: %s" err) >> return []-    Right ws -> return ws--  let workspacesCount = length workspaces-      workspacesWindowsSum = sum (map hwiWindows workspaces)-  (clientsOk, clients) <- case clientsResult of-    Left err -> do-      wLog WARNING $-        printf-          "hyprctl clients failed: %s (workspaces=%d windowsSum=%d)"-          err-          workspacesCount-          workspacesWindowsSum-      return (False, [])-    Right cs -> return (True, cs)--  monitors <- case monitorsResult of-    Left err -> wLog WARNING (printf "hyprctl monitors failed: %s" err) >> return []-    Right ms -> return ms--  activeWorkspace <- case activeWorkspaceResult of-    Left err -> wLog WARNING (printf "hyprctl activeworkspace failed: %s" err) >> return Nothing-    Right ws -> return $ Just ws--  buildWorkspacesFromHyprland-    workspaces-    clientsOk-    clients-    monitors-    activeWorkspace-    activeWindowAddress--getActiveWindowAddress :: TaffyIO (Maybe Text)-getActiveWindowAddress = do-  result <- runHyprctlJson ["-j", "activewindow"]-  case result of-    Left _ -> return Nothing-    Right activeWindow -> return $ Just $ hawAddress activeWindow--buildWorkspacesFromHyprland ::-  [HyprlandWorkspaceInfo] ->-  Bool ->-  [HyprlandClient] ->-  [HyprlandMonitorInfo] ->-  Maybe HyprlandWorkspaceRef ->-  Maybe Text ->-  TaffyIO [HyprlandWorkspace]-buildWorkspacesFromHyprland workspaces clientsOk clients monitors activeWorkspace activeWindowAddress = do-  let windowsByWorkspace = collectWorkspaceWindows activeWindowAddress clients-      sortedWorkspaces = sortOn hwiId workspaces-      visibleWorkspaceIds =-        map hwrId $ mapMaybe hmActiveWorkspace monitors-      focusedWorkspaceId =-        listToMaybe-          [ hwrId ws-          | m <- monitors,-            hmFocused m,-            Just ws <- [hmActiveWorkspace m]-          ]-      activeWorkspaceId =-        focusedWorkspaceId <|> fmap hwrId activeWorkspace--  return $ map (buildWorkspace windowsByWorkspace visibleWorkspaceIds activeWorkspaceId) sortedWorkspaces-  where-    buildWorkspace windowsMap visibleIds activeId wsInfo =-      let wsId = hwiId wsInfo-          wsName = hwiName wsInfo-          wins = M.findWithDefault [] wsId windowsMap-          hasWindows = not (null wins) || hwiWindows wsInfo > 0-          state-            | Just wsId == activeId = Active-            | wsId `elem` visibleIds = Visible-            -- If we couldn't fetch clients, don't aggressively hide workspaces.-            -- This prevents "invisible" workspaces on transient Hyprland restarts.-            | not hasWindows && clientsOk = Empty-            | otherwise = Hidden-       in HyprlandWorkspace-            { workspaceIdx = wsId,-              workspaceName = T.unpack wsName,-              workspaceState = state,-              windows = wins-            }--collectWorkspaceWindows :: Maybe Text -> [HyprlandClient] -> M.Map Int [HyprlandWindow]-collectWorkspaceWindows activeWindowAddress =-  F.foldl' (addWindow activeWindowAddress) M.empty-  where-    addWindow activeAddr windowsMap client =-      let wsId = hwrId (hcWorkspace client)-          windowData = windowFromClient activeAddr client-       in M.insertWith (++) wsId [windowData] windowsMap--windowFromClient :: Maybe Text -> HyprlandClient -> HyprlandWindow-windowFromClient activeAddr client =-  let titleText =-        if T.null (hcTitle client)-          then fromMaybe "" (hcInitialTitle client)-          else hcTitle client-      active =-        hcFocused client || Just (hcAddress client) == activeAddr-      minimized =-        hcHidden client || not (hcMapped client)-   in HyprlandWindow-        { windowAddress = hcAddress client,-          windowTitle = T.unpack titleText,-          windowClass = T.unpack <$> hcClass client,-          windowInitialClass = T.unpack <$> hcInitialClass client,-          windowAt = hcAt client,-          windowUrgent = hcUrgent client,-          windowActive = active,-          windowMinimized = minimized-        }

@@ -1,253 +0,0 @@-{-# LANGUAGE StrictData #-}-{-# OPTIONS_GHC -Wno-deprecations #-}------------------------------------------------------------------------------------------------------------------------------------------------------------------ |--- Module      : System.Taffybar.Widget.Workspaces.Hyprland.Compat--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable------ Flat legacy compatibility config for Hyprland workspaces.------ This module is intentionally not re-exported by the umbrella widget--- modules so that consumers opt in explicitly.-module System.Taffybar.Widget.Workspaces.Hyprland.Compat-  ( HyprlandWorkspacesConfig (..),-    defaultHyprlandWorkspacesConfig,-    hyprlandWorkspacesNew,-    hyprlandWorkspacesCommonConfig,-    modifyCommonHyprlandWorkspacesConfig,-    applyCommonHyprlandWorkspacesConfig,-    toHyprlandWorkspacesConfig,-    fromHyprlandWorkspacesConfig,-    refreshWorkspaces,-    applyUrgentState,-    hyprlandBuildLabelController,-    hyprlandBuildIconController,-    hyprlandBuildContentsController,-    hyprlandBuildLabelOverlayController,-    hyprlandBuildCustomOverlayController,-    hyprlandBuildButtonController,-    defaultHyprlandWidgetBuilder,-    buildIconWidget,-    FlatHyprlandWorkspacesConfig,-    defaultFlatHyprlandWorkspacesConfig,-    fromFlatHyprlandWorkspacesConfig,-    toFlatHyprlandWorkspacesConfig,-  )-where--import Control.Monad.Trans.Reader (ReaderT)-import Data.Default (Default (..))-import Data.Int (Int32)-import qualified GI.Gtk as Gtk-import System.Taffybar.Context (Context, TaffyIO)-import System.Taffybar.Widget.Workspaces.Config-  ( WorkspaceWidgetCommonConfig (WorkspaceWidgetCommonConfig),-  )-import qualified System.Taffybar.Widget.Workspaces.Config as WorkspaceConfig-import qualified System.Taffybar.Widget.Workspaces.Hyprland as Hyprland--data HyprlandWorkspacesConfig-  = HyprlandWorkspacesConfig-  { getWorkspaces :: TaffyIO [Hyprland.HyprlandWorkspace],-    switchToWorkspace :: Hyprland.HyprlandWorkspace -> TaffyIO (),-    updateIntervalSeconds :: Double,-    widgetBuilder :: Hyprland.HyprlandControllerConstructor,-    widgetGap :: Int,-    maxIcons :: Maybe Int,-    minIcons :: Int,-    iconSize :: Int32,-    getWindowIconPixbuf :: Hyprland.HyprlandWindowIconPixbufGetter,-    labelSetter :: Hyprland.HyprlandWorkspace -> TaffyIO String,-    showWorkspaceFn :: Hyprland.HyprlandWorkspace -> Bool,-    iconSort :: [Hyprland.HyprlandWindow] -> TaffyIO [Hyprland.HyprlandWindow],-    urgentWorkspaceState :: Bool-  }--{-# DEPRECATED getWorkspaces "Legacy flat config field. Use `System.Taffybar.Widget.Workspaces.Hyprland.getWorkspaces` on the canonical nested config type instead." #-}--{-# DEPRECATED switchToWorkspace "Legacy flat config field. Use `System.Taffybar.Widget.Workspaces.Hyprland.switchToWorkspace` on the canonical nested config type instead." #-}--{-# DEPRECATED updateIntervalSeconds "Legacy flat config field. Use `System.Taffybar.Widget.Workspaces.Hyprland.updateIntervalSeconds` on the canonical nested config type instead." #-}--{-# DEPRECATED widgetBuilder "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--{-# DEPRECATED widgetGap "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--{-# DEPRECATED maxIcons "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--{-# DEPRECATED minIcons "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--{-# DEPRECATED iconSize "Legacy flat config field. Use `System.Taffybar.Widget.Workspaces.Hyprland.iconSize` on the canonical nested config type instead." #-}--{-# DEPRECATED getWindowIconPixbuf "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--{-# DEPRECATED labelSetter "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--{-# DEPRECATED showWorkspaceFn "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--{-# DEPRECATED iconSort "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--{-# DEPRECATED urgentWorkspaceState "Legacy flat config field. Use the nested `workspacesConfig` field in `System.Taffybar.Widget.Workspaces.Hyprland.HyprlandWorkspacesConfig` instead." #-}--toHyprlandWorkspacesConfig ::-  HyprlandWorkspacesConfig -> Hyprland.HyprlandWorkspacesConfig-toHyprlandWorkspacesConfig flat =-  Hyprland.HyprlandWorkspacesConfig-    { Hyprland.getWorkspaces = getWorkspaces flat,-      Hyprland.switchToWorkspace = switchToWorkspace flat,-      Hyprland.updateIntervalSeconds = updateIntervalSeconds flat,-      Hyprland.iconSize = iconSize flat,-      Hyprland.workspacesConfig =-        WorkspaceWidgetCommonConfig-          { WorkspaceConfig.widgetBuilder = widgetBuilder flat,-            WorkspaceConfig.widgetGap = widgetGap flat,-            WorkspaceConfig.maxIcons = maxIcons flat,-            WorkspaceConfig.minIcons = minIcons flat,-            WorkspaceConfig.getWindowIconPixbuf = getWindowIconPixbuf flat,-            WorkspaceConfig.labelSetter = labelSetter flat,-            WorkspaceConfig.showWorkspaceFn = showWorkspaceFn flat,-            WorkspaceConfig.iconSort = iconSort flat,-            WorkspaceConfig.urgentWorkspaceState = urgentWorkspaceState flat-          }-    }--fromHyprlandWorkspacesConfig ::-  Hyprland.HyprlandWorkspacesConfig -> HyprlandWorkspacesConfig-fromHyprlandWorkspacesConfig cfg =-  let common = Hyprland.workspacesConfig cfg-   in HyprlandWorkspacesConfig-        { getWorkspaces = Hyprland.getWorkspaces cfg,-          switchToWorkspace = Hyprland.switchToWorkspace cfg,-          updateIntervalSeconds = Hyprland.updateIntervalSeconds cfg,-          widgetBuilder = WorkspaceConfig.widgetBuilder common,-          widgetGap = WorkspaceConfig.widgetGap common,-          maxIcons = WorkspaceConfig.maxIcons common,-          minIcons = WorkspaceConfig.minIcons common,-          iconSize = Hyprland.iconSize cfg,-          getWindowIconPixbuf = WorkspaceConfig.getWindowIconPixbuf common,-          labelSetter = WorkspaceConfig.labelSetter common,-          showWorkspaceFn = WorkspaceConfig.showWorkspaceFn common,-          iconSort = WorkspaceConfig.iconSort common,-          urgentWorkspaceState = WorkspaceConfig.urgentWorkspaceState common-        }--defaultHyprlandWorkspacesConfig :: HyprlandWorkspacesConfig-defaultHyprlandWorkspacesConfig =-  fromHyprlandWorkspacesConfig Hyprland.defaultHyprlandWorkspacesConfig--hyprlandWorkspacesNew :: HyprlandWorkspacesConfig -> TaffyIO Gtk.Widget-hyprlandWorkspacesNew =-  Hyprland.hyprlandWorkspacesNew . toHyprlandWorkspacesConfig--hyprlandWorkspacesCommonConfig ::-  HyprlandWorkspacesConfig ->-  WorkspaceWidgetCommonConfig (ReaderT Context IO) Hyprland.HyprlandWorkspace Hyprland.HyprlandWindow Hyprland.HyprlandWWC-hyprlandWorkspacesCommonConfig =-  Hyprland.workspacesConfig . toHyprlandWorkspacesConfig---- | Modify the nested common config inside a legacy flat Hyprland workspaces--- config.------ Prefer this over defining @common@ in terms of a recursively-defined @cfg@,--- which can accidentally create a black-hole and hang at runtime.-modifyCommonHyprlandWorkspacesConfig ::-  ( WorkspaceWidgetCommonConfig (ReaderT Context IO) Hyprland.HyprlandWorkspace Hyprland.HyprlandWindow Hyprland.HyprlandWWC ->-    WorkspaceWidgetCommonConfig (ReaderT Context IO) Hyprland.HyprlandWorkspace Hyprland.HyprlandWindow Hyprland.HyprlandWWC-  ) ->-  HyprlandWorkspacesConfig ->-  HyprlandWorkspacesConfig-modifyCommonHyprlandWorkspacesConfig f cfg =-  applyCommonHyprlandWorkspacesConfig (f (hyprlandWorkspacesCommonConfig cfg)) cfg--applyCommonHyprlandWorkspacesConfig ::-  WorkspaceWidgetCommonConfig (ReaderT Context IO) Hyprland.HyprlandWorkspace Hyprland.HyprlandWindow Hyprland.HyprlandWWC ->-  HyprlandWorkspacesConfig ->-  HyprlandWorkspacesConfig-applyCommonHyprlandWorkspacesConfig common cfg =-  fromHyprlandWorkspacesConfig $-    Hyprland.applyCommonHyprlandWorkspacesConfig common (toHyprlandWorkspacesConfig cfg)--refreshWorkspaces ::-  HyprlandWorkspacesConfig -> Gtk.Box -> ReaderT Context IO ()-refreshWorkspaces cfg =-  Hyprland.refreshWorkspaces (toHyprlandWorkspacesConfig cfg)--applyUrgentState ::-  HyprlandWorkspacesConfig ->-  Hyprland.HyprlandWorkspace ->-  Hyprland.HyprlandWorkspace-applyUrgentState cfg =-  Hyprland.applyUrgentState (toHyprlandWorkspacesConfig cfg)--hyprlandBuildLabelController ::-  HyprlandWorkspacesConfig -> Hyprland.HyprlandControllerConstructor-hyprlandBuildLabelController =-  Hyprland.hyprlandBuildLabelController . toHyprlandWorkspacesConfig--hyprlandBuildIconController ::-  HyprlandWorkspacesConfig -> Hyprland.HyprlandControllerConstructor-hyprlandBuildIconController =-  Hyprland.hyprlandBuildIconController . toHyprlandWorkspacesConfig--hyprlandBuildContentsController ::-  [Hyprland.HyprlandControllerConstructor] -> Hyprland.HyprlandControllerConstructor-hyprlandBuildContentsController =-  Hyprland.hyprlandBuildContentsController--hyprlandBuildLabelOverlayController ::-  HyprlandWorkspacesConfig ->-  Hyprland.HyprlandControllerConstructor-hyprlandBuildLabelOverlayController =-  Hyprland.hyprlandBuildLabelOverlayController . toHyprlandWorkspacesConfig--hyprlandBuildCustomOverlayController ::-  (Gtk.Widget -> Gtk.Widget -> TaffyIO Gtk.Widget) ->-  HyprlandWorkspacesConfig ->-  Hyprland.HyprlandControllerConstructor-hyprlandBuildCustomOverlayController overlay cfg =-  Hyprland.hyprlandBuildCustomOverlayController-    overlay-    (toHyprlandWorkspacesConfig cfg)--hyprlandBuildButtonController ::-  HyprlandWorkspacesConfig ->-  Hyprland.HyprlandParentControllerConstructor-hyprlandBuildButtonController cfg =-  Hyprland.hyprlandBuildButtonController (toHyprlandWorkspacesConfig cfg)--defaultHyprlandWidgetBuilder ::-  HyprlandWorkspacesConfig -> Hyprland.HyprlandControllerConstructor-defaultHyprlandWidgetBuilder =-  Hyprland.defaultHyprlandWidgetBuilder . toHyprlandWorkspacesConfig--buildIconWidget ::-  Bool ->-  HyprlandWorkspacesConfig ->-  ReaderT Context IO Hyprland.HyprlandIconWidget-buildIconWidget transparentOnNone cfg =-  Hyprland.buildIconWidget transparentOnNone (toHyprlandWorkspacesConfig cfg)--type FlatHyprlandWorkspacesConfig = HyprlandWorkspacesConfig--defaultFlatHyprlandWorkspacesConfig :: FlatHyprlandWorkspacesConfig-defaultFlatHyprlandWorkspacesConfig = defaultHyprlandWorkspacesConfig--fromFlatHyprlandWorkspacesConfig ::-  FlatHyprlandWorkspacesConfig -> Hyprland.HyprlandWorkspacesConfig-fromFlatHyprlandWorkspacesConfig = toHyprlandWorkspacesConfig--toFlatHyprlandWorkspacesConfig ::-  Hyprland.HyprlandWorkspacesConfig -> FlatHyprlandWorkspacesConfig-toFlatHyprlandWorkspacesConfig = fromHyprlandWorkspacesConfig--instance Default HyprlandWorkspacesConfig where-  def = defaultHyprlandWorkspacesConfig

@@ -1,18 +0,0 @@----------------------------------------------------------------------------------------------------------------------------------------------------------------- |--- Module      : System.Taffybar.Widget.Workspaces.X11--- Copyright   : (c) Ivan A. Malison--- License     : BSD3-style (see LICENSE)------ Maintainer  : Ivan A. Malison--- Stability   : unstable--- Portability : unportable-module System.Taffybar.Widget.Workspaces.X11-  ( module System.Taffybar.Widget.Workspaces.EWMH,-  )-where--import System.Taffybar.Widget.Workspaces.EWMH

@@ -51,7 +51,7 @@   deriving (Eq, Ord, Show)  newtype WindowIconCache = WindowIconCache-  { windowIconCacheEntries :: MV.MVar (M.Map WindowIconCacheKey (Maybe Gdk.Pixbuf))+  { windowIconCacheEntries :: MV.MVar (M.Map WindowIconCacheKey Gdk.Pixbuf)   }   deriving (Typeable) @@ -85,10 +85,13 @@   WindowIconCache {windowIconCacheEntries = entriesVar} <- getWindowIconCache   cached <- liftIO $ M.lookup cacheKey <$> MV.readMVar entriesVar   case cached of-    Just icon -> return icon+    Just icon -> return $ Just icon     Nothing -> do       icon <- buildIcon-      liftIO $ MV.modifyMVar_ entriesVar (return . M.insert cacheKey icon)+      liftIO $+        forM_ icon $+          \resolvedIcon ->+            MV.modifyMVar_ entriesVar (return . M.insert cacheKey resolvedIcon)       return icon  isThemeIconCacheKey :: WindowIconCacheKey -> Bool@@ -97,14 +100,14 @@ isThemeIconCacheKey (EWMHIconCacheKey _ _) = False  invalidateThemeWindowIconCacheEntries ::-  MV.MVar (M.Map WindowIconCacheKey (Maybe Gdk.Pixbuf)) ->+  MV.MVar (M.Map WindowIconCacheKey Gdk.Pixbuf) ->   IO () invalidateThemeWindowIconCacheEntries entriesVar =   MV.modifyMVar_ entriesVar $     return . M.filterWithKey (\k _ -> not (isThemeIconCacheKey k))  invalidateEWMHWindowIconCacheEntriesForWindow ::-  MV.MVar (M.Map WindowIconCacheKey (Maybe Gdk.Pixbuf)) ->+  MV.MVar (M.Map WindowIconCacheKey Gdk.Pixbuf) ->   X11Window ->   IO () invalidateEWMHWindowIconCacheEntriesForWindow entriesVar changedWindow =

@@ -1,6 +1,6 @@ cabal-version: 3.4 name: taffybar-version: 5.2.1+version: 6.0.0 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD-3-Clause license-file: LICENSE@@ -182,7 +182,6 @@                  , System.Taffybar.Widget.CPUMonitor                  , System.Taffybar.Widget.CommandRunner                  , System.Taffybar.Widget.Crypto-                 , System.Taffybar.Widget.ChannelWorkspaces                  , System.Taffybar.Widget.DiskIOMonitor                  , System.Taffybar.Widget.DiskUsage                  , System.Taffybar.Widget.FSMonitor@@ -223,17 +222,8 @@                  , System.Taffybar.Widget.Text.NetworkMonitor                  , System.Taffybar.Widget.Util                  , System.Taffybar.Widget.Weather-                 , System.Taffybar.Widget.HyprlandWorkspaces-                 , System.Taffybar.Widget.Workspaces.Hyprland                  , System.Taffybar.Widget.Windows                  , System.Taffybar.Widget.Workspaces-                 , System.Taffybar.Widget.Workspaces.Config-                 , System.Taffybar.Widget.Workspaces.Common-                 , System.Taffybar.Widget.Workspaces.EWMH-                 , System.Taffybar.Widget.Workspaces.EWMH.Compat-                 , System.Taffybar.Widget.Workspaces.X11-                 , System.Taffybar.Widget.Workspaces.Hyprland.Compat-                 , System.Taffybar.Widget.Workspaces.Channel                  , System.Taffybar.Widget.Workspaces.Shared                  , System.Taffybar.Widget.WirePlumber                  , System.Taffybar.Widget.Wlsunset@@ -382,7 +372,6 @@                , System.Taffybar.Information.X11DesktopInfoSpec                , System.Taffybar.Information.WakeupSpec                , System.Taffybar.SimpleConfigSpec-               , System.Taffybar.Widget.HyprlandWorkspacesSpec                , System.Taffybar.Widget.Workspaces.ChannelSpec                , System.Taffybar.Widget.WindowsSpec   build-depends: data-default

binary file changed (2033 → 1924 bytes)

binary file changed (1661 → 1506 bytes)

binary file changed (3864 → 3729 bytes)

@@ -1,35 +0,0 @@-module System.Taffybar.Widget.HyprlandWorkspacesSpec where--import Data.Text qualified as T-import System.Taffybar.Widget.Workspaces.Hyprland-  ( HyprlandWindow (..),-    sortHyprlandWindowsByPosition,-  )-import Test.Hspec--mkWin :: String -> Bool -> Maybe (Int, Int) -> HyprlandWindow-mkWin addr minimized atPos =-  HyprlandWindow-    { windowAddress = T.pack addr,-      windowTitle = addr,-      windowClass = Nothing,-      windowInitialClass = Nothing,-      windowAt = atPos,-      windowUrgent = False,-      windowActive = False,-      windowMinimized = minimized-    }--spec :: Spec-spec = do-  describe "sortHyprlandWindowsByPosition" $ do-    it "orders non-minimized windows first, then by (x, y) position" $ do-      let a = mkWin "a" False (Just (10, 0))-          b = mkWin "b" False (Just (0, 100))-          c = mkWin "c" True (Just (0, 0))-      sortHyprlandWindowsByPosition [a, b, c] `shouldBe` [b, a, c]--    it "puts windows without a position at the end" $ do-      let a = mkWin "a" False Nothing-          b = mkWin "b" False (Just (0, 0))-      sortHyprlandWindowsByPosition [a, b] `shouldBe` [b, a]