taffybar 7.2.6 → 7.2.7

raw patch · 33 files changed

+2352/−319 lines, 33 filesdep ~dbus-menudep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: dbus-menu, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +52/−0
• src/System/Taffybar/Information/ASUS.hs +120/−55
• src/System/Taffybar/Information/AnthropicUsage.hs +28/−8
• src/System/Taffybar/Information/Backlight.hs +4/−4
• src/System/Taffybar/Information/Battery.hs +2/−1
• src/System/Taffybar/Information/CPU2.hs +137/−17
• src/System/Taffybar/Information/CPUFrequency.hs +203/−0
• src/System/Taffybar/Information/Memory.hs +42/−0
• src/System/Taffybar/Information/Nvidia.hs +249/−16
• src/System/Taffybar/Information/Temperature.hs +57/−5
• src/System/Taffybar/Information/Wakeup.hs +14/−0
• src/System/Taffybar/Information/Wakeup/Manager.hs +87/−3
• src/System/Taffybar/Information/Wlsunset.hs +52/−23
• src/System/Taffybar/Widget/ASUS.hs +125/−40
• src/System/Taffybar/Widget/AnthropicUsage.hs +83/−11
• src/System/Taffybar/Widget/Backlight.hs +1/−1
• src/System/Taffybar/Widget/Battery.hs +31/−5
• src/System/Taffybar/Widget/CPUFrequency.hs +88/−0
• src/System/Taffybar/Widget/CPUMonitor.hs +60/−5
• src/System/Taffybar/Widget/NvidiaTemperature.hs +160/−30
• src/System/Taffybar/Widget/OpenAIUsage.hs +132/−29
• src/System/Taffybar/Widget/SNITray/PrioritizedCollapsible.hs +99/−31
• src/System/Taffybar/Widget/Temperature.hs +81/−24
• src/System/Taffybar/Widget/Util.hs +19/−0
• taffybar.cabal +12/−2
• taffybar.css +14/−0
• test/unit/DBusMenuSpec.hs +74/−0
• test/unit/System/Taffybar/Information/ASUSSpec.hs +14/−0
• test/unit/System/Taffybar/Information/CPUFrequencySpec.hs +22/−0
• test/unit/System/Taffybar/Information/NvidiaSpec.hs +83/−9
• test/unit/System/Taffybar/Widget/AnthropicUsageSpec.hs +77/−0
• test/unit/System/Taffybar/Widget/BatterySpec.hs +40/−0
• test/unit/System/Taffybar/Widget/OpenAIUsageSpec.hs +90/−0

@@ -1,3 +1,55 @@+# 7.2.7++## Features++* Add shared channel-backed producers and channel-driven widget variants for+  CPU load, CPU frequency, memory, sysfs temperature, and NVIDIA telemetry.+* Add temporary coordinated wakeup subscriptions and let CPU graphs acquire a+  fast shared sampling cadence while hovered, releasing it when the pointer+  leaves.+* Add a configurable CPU-frequency information source and compact widget with+  average, range, and policy-count reporting.+* Enrich NVIDIA temperature tooltips with target and memory temperatures,+  thermal headroom, utilization, VRAM, power, fan, and performance-state+  readings. Sysfs temperature widgets can now include additional sensors in+  the tooltip without changing the compact label's aggregation.+* Add separate ASUS AC and battery power-profile controls and combine their+  state into one menu.+* Show the current day of Claude's 7-day usage window in the Anthropic usage+  widget when the OAuth endpoint reports a reset timestamp.+* Show the current day of Codex's 7-day usage window as a compact @N/7d@ value in+  the OpenAI usage widget when the endpoint reports an authoritative reset.+* Let OpenAI and Anthropic usage stacks render structured window-label parts+  with caller-supplied functions, so configurations can control ordering and+  separators without duplicating widget or usage-calculation internals.+* Allow text battery widgets to display UPower's current energy rate with the+  @$watts$@ placeholder or as battery input/output with @$signedWatts$@, and+  refresh the value on UPower sampling updates.+* Add polling-driven hover expansion and styling refinements to the prioritized+  StatusNotifier tray.++## Performance++* Slow hardware telemetry defaults, share producers across widgets, align+  periodic work through the coordinated wakeup scheduler, and suppress+  unchanged channel updates.+* Avoid invoking `nvidia-smi` while every detected NVIDIA device is+  runtime-suspended.+* Wait for wlsunset process-exit events instead of repeatedly polling process+  state while it is running.++## Fixes++* Show Codex's temporarily disabled 5-hour usage limit as unlimited while+  keeping its remaining 7-day window in the weekly row.+* Tolerate unreadable or concurrently replaced Anthropic transcript and+  credential files.++## Packaging++* Require `dbus-menu >= 0.1.3.4` for refresh reconciliation that preserves GTK+  menu items across asynchronous layout updates.+ # 7.2.6  ## Features

@@ -24,15 +24,18 @@     getASUSInfoState,     cycleASUSProfile,     setASUSProfile,+    setASUSACProfile,+    setASUSBatteryProfile,     asusProfileToString,     asusProfileFromUInt,+    asusProfileToUInt,   ) where  import Control.Concurrent.MVar import Control.Concurrent.STM.TChan import Control.Exception (SomeException, try)-import Control.Monad (forM, forever, void)+import Control.Monad (forM, forever, void, when) import Control.Monad.IO.Class import Control.Monad.STM (atomically) import Control.Monad.Trans.Class@@ -52,6 +55,10 @@ import System.FilePath ((</>)) import System.Log.Logger import System.Taffybar.Context+import System.Taffybar.Information.CPUFrequency+  ( cpuFrequencyAverageGHz,+    readCPUFrequencyInfo,+  ) import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay) import System.Taffybar.Util (logPrintF, maybeToEither) import Text.Read (readMaybe)@@ -63,6 +70,12 @@ -- | Combined ASUS platform info with CPU state. data ASUSInfo = ASUSInfo   { asusProfile :: ASUSPlatformProfile,+    -- | Profile selected automatically while connected to AC power+    asusACProfile :: ASUSPlatformProfile,+    -- | Profile selected automatically while running on battery power+    asusBatteryProfile :: ASUSPlatformProfile,+    -- | Whether the machine is currently connected to AC power+    asusOnACPower :: Bool,     -- | Average CPU frequency across all cores     asusCpuFreqGHz :: Double,     -- | CPU package temperature in Celsius@@ -87,6 +100,9 @@ asusLogF :: (MonadIO m, Show t) => Priority -> String -> t -> m () asusLogF = logPrintF asusLogPath +defaultASUSPollIntervalSeconds :: Double+defaultASUSPollIntervalSeconds = 10+ readAsciiFileStrict :: FilePath -> IO String readAsciiFileStrict = fmap BS8.unpack . BS8.readFile @@ -96,23 +112,26 @@ asusProfileToString Balanced = "Balanced" asusProfileToString Performance = "Performance" --- | Parse profile from asusd uint32: 0=Quiet, 1=Performance, 2=Balanced.+-- | Parse profile from asusd uint32: 0=Balanced, 1=Performance, 2=Quiet. asusProfileFromUInt :: Word32 -> Maybe ASUSPlatformProfile-asusProfileFromUInt 0 = Just Quiet+asusProfileFromUInt 0 = Just Balanced asusProfileFromUInt 1 = Just Performance-asusProfileFromUInt 2 = Just Balanced+asusProfileFromUInt 2 = Just Quiet asusProfileFromUInt _ = Nothing  asusProfileToUInt :: ASUSPlatformProfile -> Word32-asusProfileToUInt Quiet = 0+asusProfileToUInt Balanced = 0 asusProfileToUInt Performance = 1-asusProfileToUInt Balanced = 2+asusProfileToUInt Quiet = 2  -- | Default info when asusd is unavailable. unknownASUSInfo :: ASUSInfo unknownASUSInfo =   ASUSInfo     { asusProfile = Balanced,+      asusACProfile = Performance,+      asusBatteryProfile = Balanced,+      asusOnACPower = False,       asusCpuFreqGHz = 0,       asusCpuTempC = 0     }@@ -139,25 +158,34 @@       maybeToEither dummyMethodError $         listToMaybe (methodReturnBody reply) >>= fromVariant --- | Read current platform profile from DBus.-readProfileFromClient :: Client -> IO ASUSPlatformProfile-readProfileFromClient client = do+-- | Read the live, AC, and battery platform profiles from DBus.+readProfilesFromClient ::+  Client ->+  IO (ASUSPlatformProfile, ASUSPlatformProfile, ASUSPlatformProfile)+readProfilesFromClient client = do   propsResult <- getProperties client   case propsResult of     Left err -> do       asusLogF WARNING "Failed to read ASUS properties: %s" err-      return Balanced-    Right props ->-      let profileVal = readDictMaybe props "PlatformProfile" :: Maybe Word32-       in return $ fromMaybe Balanced (profileVal >>= asusProfileFromUInt)+      return (Balanced, Performance, Balanced)+    Right props -> do+      let readProfile key fallback =+            fromMaybe fallback $+              (readDictMaybe props key :: Maybe Word32) >>= asusProfileFromUInt+      return+        ( readProfile "PlatformProfile" Balanced,+          readProfile "PlatformProfileOnAc" Performance,+          readProfile "PlatformProfileOnBattery" Balanced+        ) --- | Set the ASUS platform profile via DBus property.-setASUSProfile :: Client -> ASUSPlatformProfile -> IO (Either MethodError ())-setASUSProfile client profile = do+-- | Set one of the ASUS platform profile properties.+setASUSProfileProperty ::+  Client -> MemberName -> ASUSPlatformProfile -> IO (Either MethodError ())+setASUSProfileProperty client propertyMember profile = do   result <-     setProperty       client-      (methodCall asusObjectPath asusInterfaceName "PlatformProfile")+      (methodCall asusObjectPath asusInterfaceName propertyMember)         { methodCallDestination = Just asusBusName         }       (toVariant (asusProfileToUInt profile))@@ -165,6 +193,19 @@     Left err -> Left err     Right _ -> Right () +-- | Set the ASUS platform profile via DBus property.+setASUSProfile :: Client -> ASUSPlatformProfile -> IO (Either MethodError ())+setASUSProfile client = setASUSProfileProperty client "PlatformProfile"++-- | Set the profile that asusd applies while connected to AC power.+setASUSACProfile :: Client -> ASUSPlatformProfile -> IO (Either MethodError ())+setASUSACProfile client = setASUSProfileProperty client "PlatformProfileOnAc"++-- | Set the profile that asusd applies while running on battery power.+setASUSBatteryProfile :: Client -> ASUSPlatformProfile -> IO (Either MethodError ())+setASUSBatteryProfile client =+  setASUSProfileProperty client "PlatformProfileOnBattery"+ -- | Cycle to the next profile by calling the NextPlatformProfile method. cycleASUSProfile :: Client -> IO (Either MethodError ()) cycleASUSProfile client = do@@ -177,38 +218,30 @@     Left err -> Left err     Right _ -> Right () --- sysfs CPU frequency reading---- | Read average CPU frequency in GHz from sysfs.-readCpuFreqGHz :: IO Double-readCpuFreqGHz = do-  let cpuDir = "/sys/devices/system/cpu"-  exists <- doesDirectoryExist cpuDir+-- | Check whether any mains power supply is currently online.+readOnACPower :: IO Bool+readOnACPower = do+  let powerSupplyDir = "/sys/class/power_supply"+  exists <- doesDirectoryExist powerSupplyDir   if not exists-    then return 0+    then return False     else do-      entries <- listDirectory cpuDir-      let cpuDirs = filter isCpuDir entries-      freqs <- forM cpuDirs $ \cpu -> do-        let freqPath = cpuDir </> cpu </> "cpufreq" </> "scaling_cur_freq"-        readFreqFile freqPath-      let validFreqs = catMaybes freqs-      if null validFreqs-        then return 0-        else return $ (sum validFreqs / fromIntegral (length validFreqs)) / 1_000_000+      entries <- listDirectory powerSupplyDir+      statuses <- forM entries $ \entry -> do+        let supplyDir = powerSupplyDir </> entry+        supplyType <- readPowerSupplyFile $ supplyDir </> "type"+        online <- readPowerSupplyFile $ supplyDir </> "online"+        return $ supplyType == Just "Mains" && online == Just "1"+      return $ or statuses   where-    isCpuDir name =-      take 3 name == "cpu" && all (`elem` ("0123456789" :: String)) (drop 3 name)-    readFreqFile path = do+    readPowerSupplyFile path = do       exists' <- doesFileExist path       if not exists'         then return Nothing         else do           result <- try $ readAsciiFileStrict path :: IO (Either SomeException String)-          case result of-            Left _ -> return Nothing-            Right s -> return $ fmap fromIntegral (readMaybe (strip s) :: Maybe Integer)-    strip = dropWhile (== ' ') . reverse . dropWhile (== '\n') . reverse . dropWhile (== ' ')+          return $ either (const Nothing) (Just . strip) result+    strip = reverse . dropWhile (`elem` [' ', '\n', '\r', '\t']) . reverse  -- sysfs CPU temperature reading @@ -269,13 +302,25 @@ -- | Get current ASUS info from a DBus client. getASUSInfoFromClient :: Client -> IO ASUSInfo getASUSInfoFromClient client = do-  profile <- readProfileFromClient client-  freq <- readCpuFreqGHz+  (profile, acProfile, batteryProfile) <- readProfilesFromClient client+  readASUSTelemetry+    unknownASUSInfo+      { asusProfile = profile,+        asusACProfile = acProfile,+        asusBatteryProfile = batteryProfile+      }++-- | Refresh telemetry that has no event interface while preserving the+-- profile values maintained by the asusd PropertiesChanged subscription.+readASUSTelemetry :: ASUSInfo -> IO ASUSInfo+readASUSTelemetry old = do+  onACPower <- readOnACPower+  frequencyInfo <- readCPUFrequencyInfo   temp <- readCpuTempC   return-    ASUSInfo-      { asusProfile = profile,-        asusCpuFreqGHz = freq,+    old+      { asusOnACPower = onACPower,+        asusCpuFreqGHz = fromMaybe 0 $ cpuFrequencyAverageGHz frequencyInfo,         asusCpuTempC = temp       } @@ -304,20 +349,20 @@ monitorASUSInfo = do   infoVar <- lift $ newMVar unknownASUSInfo   chan <- liftIO newBroadcastTChanIO-  wakeupChan <- getWakeupChannelForDelay (2 :: Double)+  wakeupChan <- getWakeupChannelForDelay defaultASUSPollIntervalSeconds   ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan   taffyFork $ do     ctx <- ask-    let updateInfo = updateASUSInfo chan infoVar-        signalCallback _ _ _ _ = runReaderT updateInfo ctx+    let updateProfiles = updateASUSInfo chan infoVar+        signalCallback _ _ _ _ = runReaderT updateProfiles ctx         waitForNextPoll = void $ atomically $ readTChan ourWakeupChan     _ <- registerForASUSPropertiesChanged signalCallback     -- Do an initial update-    updateInfo-    -- Then poll every 2 seconds for CPU freq/temp changes+    updateProfiles+    -- Profile changes are subscription-driven. Only sysfs telemetry is polled.     lift $ forever $ do       waitForNextPoll-      runReaderT updateInfo ctx+      updateASUSTelemetry chan infoVar   return (chan, infoVar)  registerForASUSPropertiesChanged ::@@ -340,6 +385,26 @@   TaffyIO () updateASUSInfo chan var = do   info <- getASUSInfo-  lift $ do-    void $ swapMVar var info-    atomically $ writeTChan chan info+  lift $ publishASUSInfoIfChanged chan var info++updateASUSTelemetry :: TChan ASUSInfo -> MVar ASUSInfo -> IO ()+updateASUSTelemetry chan var = do+  telemetry <- readASUSTelemetry =<< readMVar var+  modifyMVar_ var $ \latest -> do+    let info =+          latest+            { asusOnACPower = asusOnACPower telemetry,+              asusCpuFreqGHz = asusCpuFreqGHz telemetry,+              asusCpuTempC = asusCpuTempC telemetry+            }+    publishAgainst latest info+  where+    publishAgainst old info = do+      when (info /= old) $ atomically $ writeTChan chan info+      pure info++publishASUSInfoIfChanged :: TChan ASUSInfo -> MVar ASUSInfo -> ASUSInfo -> IO ()+publishASUSInfoIfChanged chan var info =+  modifyMVar_ var $ \old -> do+    when (info /= old) $ atomically $ writeTChan chan info+    pure info

@@ -124,6 +124,10 @@   { anthropicUsageWindowName :: T.Text,     anthropicUsageWindowStart :: UTCTime,     anthropicUsageWindowEnd :: UTCTime,+    -- | Authoritative reset time reported by the OAuth usage endpoint. The+    -- fallback transcript windows synthesize an end time, but do not claim to+    -- know when Claude's server-side limit resets.+    anthropicUsageWindowResetAt :: Maybe UTCTime,     anthropicUsageWindowBudgetTokens :: Maybe Int,     -- | Used percentage reported by the OAuth usage endpoint, when available.     anthropicUsageWindowUtilizationPercent :: Maybe Double,@@ -576,9 +580,9 @@ findScopedWeeklyLimit usage =   listToMaybe     [ limit-      | limit <- anthropicOAuthLimits usage,-        anthropicOAuthLimitKind limit == Just "weekly_scoped",-        Just _ <- [anthropicOAuthLimitScopeModel limit]+    | limit <- anthropicOAuthLimits usage,+      anthropicOAuthLimitKind limit == Just "weekly_scoped",+      Just _ <- [anthropicOAuthLimitScopeModel limit]     ]  -- | Build a display window for a per-model weekly limit. There is no@@ -593,6 +597,7 @@       anthropicUsageWindowStart =         maybe now (addUTCTime (negate weekSeconds)) resetsAt,       anthropicUsageWindowEnd = fromMaybe (addUTCTime weekSeconds now) resetsAt,+      anthropicUsageWindowResetAt = resetsAt,       anthropicUsageWindowBudgetTokens = Nothing,       anthropicUsageWindowUtilizationPercent = anthropicOAuthLimitPercent limit,       anthropicUsageWindowTotals = mempty@@ -607,18 +612,30 @@   window     { anthropicUsageWindowUtilizationPercent = anthropicOAuthWindowUtilization oauthWindow,       anthropicUsageWindowEnd =-        fromMaybe (anthropicUsageWindowEnd window) (anthropicOAuthWindowResetsAt oauthWindow)+        fromMaybe (anthropicUsageWindowEnd window) (anthropicOAuthWindowResetsAt oauthWindow),+      anthropicUsageWindowResetAt = anthropicOAuthWindowResetsAt oauthWindow     } +-- | Decode a JSON file, treating an unreadable or unparseable file the same+-- as an absent one. Claude Code rewrites its state files in place, so a poll+-- can catch them mid-write; a failed read of optional metadata must degrade+-- to 'Nothing' rather than throw and blank the whole usage snapshot. decodeFileIfExists :: (FromJSON a) => FilePath -> IO (Maybe a) decodeFileIfExists path = do   exists <- doesFileExist path   if exists     then do-      bytes <- LBS.readFile path-      case eitherDecode bytes of-        Right value -> return $ Just value-        Left err -> fail $ "Unable to parse " <> path <> ": " <> err+      result <- try $ do+        bytes <- LBS.readFile path+        evaluate $ eitherDecode bytes+      case result of+        Right (Right value) -> return $ Just value+        Right (Left err) -> do+          logM logName WARNING $ "Unable to parse " <> path <> ": " <> err+          return Nothing+        Left (err :: SomeException) -> do+          logM logName WARNING $ "Unable to read " <> path <> ": " <> show err+          return Nothing     else return Nothing  defaultClaudeStatePath :: IO FilePath@@ -767,6 +784,7 @@         { anthropicUsageWindowName = name,           anthropicUsageWindowStart = now,           anthropicUsageWindowEnd = addUTCTime duration now,+          anthropicUsageWindowResetAt = Nothing,           anthropicUsageWindowBudgetTokens = budget,           anthropicUsageWindowUtilizationPercent = Nothing,           anthropicUsageWindowTotals = mempty@@ -776,6 +794,7 @@         { anthropicUsageWindowName = name,           anthropicUsageWindowStart = start,           anthropicUsageWindowEnd = addUTCTime duration start,+          anthropicUsageWindowResetAt = Nothing,           anthropicUsageWindowBudgetTokens = budget,           anthropicUsageWindowUtilizationPercent = Nothing,           anthropicUsageWindowTotals = foldMap transcriptUsageTotals blockEntries@@ -813,6 +832,7 @@         { anthropicUsageWindowName = name,           anthropicUsageWindowStart = windowStart,           anthropicUsageWindowEnd = windowEnd,+          anthropicUsageWindowResetAt = Nothing,           anthropicUsageWindowBudgetTokens = budget,           anthropicUsageWindowUtilizationPercent = Nothing,           anthropicUsageWindowTotals = foldMap transcriptUsageTotals windowEntries

@@ -32,7 +32,7 @@ import Control.Concurrent.MVar import Control.Concurrent.STM.TChan import Control.Exception (SomeException, bracket, catch, try)-import Control.Monad (forever, void)+import Control.Monad (forever, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.STM (atomically) import Data.List (sort, sortBy)@@ -60,7 +60,7 @@ backlightBasePath = "/sys/class/backlight"  defaultBacklightRefreshIntervalSeconds :: Double-defaultBacklightRefreshIntervalSeconds = 2+defaultBacklightRefreshIntervalSeconds = 30  -- | Information about a backlight device. data BacklightInfo = BacklightInfo@@ -175,8 +175,8 @@       intervalMicros = max 1 (floor (intervalSeconds * 1000000))        writeInfo info = do-        _ <- swapMVar var info-        atomically $ writeTChan chan info+        old <- swapMVar var info+        when (info /= old) $ atomically $ writeTChan chan info        refresh = getBacklightInfo deviceOverride >>= writeInfo 

@@ -198,7 +198,8 @@  -- | Default set of UPower properties that trigger display-battery refreshes. defaultMonitorDisplayBatteryProperties :: [String]-defaultMonitorDisplayBatteryProperties = ["IconName", "State", "Percentage"]+defaultMonitorDisplayBatteryProperties =+  ["IconName", "State", "Percentage", "EnergyRate", "UpdateTime"]  -- | Start the monitoring of the display battery, and setup the associated -- channel and mvar for the current state.

@@ -20,20 +20,34 @@ -- (Now supports only physical cpu). module System.Taffybar.Information.CPU2 where -import Control.Concurrent (forkIO)+import Control.Concurrent (ThreadId, forkIO, killThread)+import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar)+import Control.Concurrent.STM (STM, orElse) import Control.Concurrent.STM.TChan import Control.Monad import Control.Monad.IO.Class (liftIO) import Control.Monad.STM (atomically)+import Control.Monad.Trans.Reader (asks) import Data.IORef import Data.List+import qualified Data.Map.Strict as M import Data.Maybe+import Data.Word (Word64) import Safe import System.Directory import System.FilePath-import System.Taffybar.Context (TaffyIO)+import System.Log.Logger (Priority (DEBUG), logM)+import System.Taffybar.Context (TaffyIO, getStateDefault, wakeupManager) import System.Taffybar.Information.StreamInfo-import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay)+import System.Taffybar.Information.Wakeup+  ( WakeupSubscription (..),+    intervalSecondsToNanoseconds,+  )+import System.Taffybar.Information.Wakeup.Manager+  ( WakeupManager,+    registerWakeupInterval,+    subscribeWakeupInterval,+  ) import Text.Read (readMaybe)  -- | Relative CPU load values, expressed as ratios in [0,1].@@ -75,26 +89,132 @@ sampleCPULoad :: Double -> String -> IO CPULoad sampleCPULoad interval cpu = toCPULoad <$> getLoad interval (getCPUInfo cpu) --- | Build a broadcast channel that is fed by a polling thread.+-- | A shared CPU information producer with an optional temporary fast cadence.+-- The fast cadence still comes from the coordinated wakeup scheduler and is+-- removed entirely when its final lease is released.+data CPULoadSource = CPULoadSource+  { cpuLoadSourceChannel :: TChan CPULoad,+    forceCPULoadRefresh :: IO (),+    acquireCPULoadFastRefresh :: IO (IO ())+  }++type CPULoadSourceKey = (String, Word64, Word64)++newtype CPULoadSources+  = CPULoadSources (MVar (M.Map CPULoadSourceKey CPULoadSource))++data FastRefreshState+  = FastRefreshInactive+  | FastRefreshActive !Int !ThreadId !WakeupSubscription++cpuLoadLogPath :: String+cpuLoadLogPath = "System.Taffybar.Information.CPU2"++defaultCPUFastRefreshInterval :: Double -> Double+defaultCPUFastRefreshInterval baseInterval = min baseInterval 0.5++-- | Return a process-wide CPU source keyed by CPU name and both cadences. The+-- normal cadence is permanently registered; the fast cadence is only active+-- while at least one caller holds a lease from 'acquireCPULoadFastRefresh'.+getCPULoadSource :: String -> Double -> Double -> TaffyIO CPULoadSource+getCPULoadSource cpu baseInterval fastInterval = do+  baseNs <- intervalNanosecondsOrFail baseInterval+  fastNs <- intervalNanosecondsOrFail fastInterval+  manager <- asks wakeupManager+  CPULoadSources sourcesVar <-+    getStateDefault $ liftIO $ CPULoadSources <$> newMVar M.empty+  liftIO $+    modifyMVar sourcesVar $ \sources ->+      case M.lookup (cpu, baseNs, fastNs) sources of+        Just source -> pure (sources, source)+        Nothing -> do+          source <- createCPULoadSource manager cpu baseNs fastNs+          pure (M.insert (cpu, baseNs, fastNs) source sources, source)++intervalNanosecondsOrFail :: Double -> TaffyIO Word64+intervalNanosecondsOrFail interval =+  case intervalSecondsToNanoseconds (max 0.000001 interval) of+    Left err -> fail err+    Right intervalNs -> pure intervalNs++createCPULoadSource :: WakeupManager -> String -> Word64 -> Word64 -> IO CPULoadSource+createCPULoadSource manager cpu baseIntervalNs fastIntervalNs = do+  baseChannel <- registerWakeupInterval manager baseIntervalNs+  ourBaseChannel <- atomically $ dupTChan baseChannel+  refreshChannel <- newTChanIO+  outputChannel <- newBroadcastTChanIO+  initial <- getCPUInfo cpu+  sampleRef <- newIORef initial+  fastStateVar <- newMVar FastRefreshInactive+  void $ forkIO $ forever $ do+    atomically $ do+      void (readTChan ourBaseChannel) `orElse` void (readTChan refreshChannel)+      drainTChan ourBaseChannel+      drainTChan refreshChannel+    load <- toCPULoad <$> getAccLoad sampleRef (getCPUInfo cpu)+    atomically $ writeTChan outputChannel load+  let forceRefresh = atomically $ writeTChan refreshChannel ()+  pure+    CPULoadSource+      { cpuLoadSourceChannel = outputChannel,+        forceCPULoadRefresh = forceRefresh,+        acquireCPULoadFastRefresh = do+          release <-+            if fastIntervalNs >= baseIntervalNs+              then pure $ pure ()+              else acquireFastRefresh manager fastIntervalNs refreshChannel fastStateVar+          forceRefresh+          pure release+      }++acquireFastRefresh :: WakeupManager -> Word64 -> TChan () -> MVar FastRefreshState -> IO (IO ())+acquireFastRefresh manager intervalNs refreshChannel stateVar = do+  modifyMVar_ stateVar $ \state ->+    case state of+      FastRefreshActive count threadId subscription ->+        pure $ FastRefreshActive (count + 1) threadId subscription+      FastRefreshInactive -> do+        logM cpuLoadLogPath DEBUG $ "Acquiring fast CPU refresh lease at " <> show intervalNs <> "ns"+        subscription <- subscribeWakeupInterval manager intervalNs+        ourChannel <- atomically $ dupTChan $ wakeupSubscriptionChannel subscription+        threadId <-+          forkIO $+            forever $+              atomically (readTChan ourChannel)+                >> atomically (writeTChan refreshChannel ())+        pure $ FastRefreshActive 1 threadId subscription+  releasedRef <- newIORef False+  pure $ do+    shouldRelease <- atomicModifyIORef' releasedRef $ \released -> (True, not released)+    when shouldRelease $+      modifyMVar_ stateVar $ \state ->+        case state of+          FastRefreshInactive -> pure FastRefreshInactive+          FastRefreshActive count threadId subscription+            | count > 1 -> pure $ FastRefreshActive (count - 1) threadId subscription+            | otherwise -> do+                logM cpuLoadLogPath DEBUG $ "Releasing fast CPU refresh lease at " <> show intervalNs <> "ns"+                killThread threadId+                releaseWakeupSubscription subscription+                pure FastRefreshInactive++drainTChan :: TChan a -> STM ()+drainTChan chan = do+  next <- tryReadTChan chan+  case next of+    Nothing -> pure ()+    Just _ -> drainTChan chan++-- | Build a broadcast channel that is fed by a shared polling producer. -- -- The polling thread is paced by the coordinated wakeup scheduler so CPU -- sampling aligns with other interval-driven widgets. ----- Each channel has its own sampling thread; if multiple widgets should share a--- data source, create once and reuse the returned channel.+-- Repeated calls with the same CPU and interval reuse one producer. getCPULoadChan :: String -> Double -> TaffyIO (TChan CPULoad) getCPULoadChan cpu interval = do-  wakeupChan <- getWakeupChannelForDelay (max 0.000001 interval)-  ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan-  liftIO $ do-    chan <- newBroadcastTChanIO-    initial <- getCPUInfo cpu-    sample <- newIORef initial-    _ <- forkIO $ forever $ do-      load <- toCPULoad <$> getAccLoad sample (getCPUInfo cpu)-      atomically $ writeTChan chan load-      void $ atomically $ readTChan ourWakeupChan-    return chan+  source <- getCPULoadSource cpu interval (defaultCPUFastRefreshInterval interval)+  pure $ cpuLoadSourceChannel source  toCPULoad :: [Double] -> CPULoad toCPULoad load =

@@ -0,0 +1,203 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : System.Taffybar.Information.CPUFrequency+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Generic Linux CPU-frequency information backed by one shared poller per+-- Taffybar process. Widgets on separate monitor bars reuse the same cached+-- snapshot and broadcast channel through the shared 'Context'.+module System.Taffybar.Information.CPUFrequency+  ( CPUFrequencyInfo (..),+    cpuFrequencyAverageGHz,+    cpuFrequencyMinimumGHz,+    cpuFrequencyMaximumGHz,+    summarizeCPUFrequencies,+    readCPUFrequencyInfo,+    getCPUFrequencyInfoChan,+    getCPUFrequencyInfoState,+  )+where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)+import Control.Concurrent.STM.TChan (TChan, dupTChan, newBroadcastTChanIO, readTChan, writeTChan)+import Control.Exception (SomeException, try)+import Control.Monad (filterM, forever, void, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.STM (atomically)+import qualified Data.ByteString.Char8 as BS8+import Data.List (isPrefixOf, sort)+import Data.Maybe (catMaybes, mapMaybe)+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)+import System.FilePath ((</>))+import System.Taffybar.Context (TaffyIO, getStateDefault)+import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay)+import Text.Read (readMaybe)++-- | A frequency snapshot in kHz, matching Linux's cpufreq sysfs units.+data CPUFrequencyInfo = CPUFrequencyInfo+  { cpuFrequencyAverageKHz :: Maybe Integer,+    cpuFrequencyMinimumKHz :: Maybe Integer,+    cpuFrequencyMaximumKHz :: Maybe Integer,+    cpuFrequencySampleCount :: Int+  }+  deriving (Eq, Show)++emptyCPUFrequencyInfo :: CPUFrequencyInfo+emptyCPUFrequencyInfo = CPUFrequencyInfo Nothing Nothing Nothing 0++cpuFrequencyAverageGHz :: CPUFrequencyInfo -> Maybe Double+cpuFrequencyAverageGHz = fmap kHzToGHz . cpuFrequencyAverageKHz++cpuFrequencyMinimumGHz :: CPUFrequencyInfo -> Maybe Double+cpuFrequencyMinimumGHz = fmap kHzToGHz . cpuFrequencyMinimumKHz++cpuFrequencyMaximumGHz :: CPUFrequencyInfo -> Maybe Double+cpuFrequencyMaximumGHz = fmap kHzToGHz . cpuFrequencyMaximumKHz++kHzToGHz :: Integer -> Double+kHzToGHz value = fromIntegral value / 1_000_000++-- | Summarize a set of per-policy or per-core frequency readings.+summarizeCPUFrequencies :: [Integer] -> CPUFrequencyInfo+summarizeCPUFrequencies [] = emptyCPUFrequencyInfo+summarizeCPUFrequencies values =+  CPUFrequencyInfo+    { cpuFrequencyAverageKHz = Just $ sum values `div` fromIntegral (length values),+      cpuFrequencyMinimumKHz = Just $ minimum values,+      cpuFrequencyMaximumKHz = Just $ maximum values,+      cpuFrequencySampleCount = length values+    }++-- | Read current frequencies from the generic Linux cpufreq interface.+-- Falls back to @/proc/cpuinfo@ on systems without cpufreq sysfs entries.+readCPUFrequencyInfo :: IO CPUFrequencyInfo+readCPUFrequencyInfo = do+  result <- try readCPUFrequencyInfoUnsafe+  pure $ either (const emptyCPUFrequencyInfo) id (result :: Either SomeException CPUFrequencyInfo)++readCPUFrequencyInfoUnsafe :: IO CPUFrequencyInfo+readCPUFrequencyInfoUnsafe = do+  paths <- discoverCPUFrequencyPaths+  readCPUFrequencyInfoFromPaths paths++discoverCPUFrequencyPaths :: IO [[FilePath]]+discoverCPUFrequencyPaths = do+  policyPaths <- discoverPolicyFrequencyPaths+  if null policyPaths then discoverCoreFrequencyPaths else pure policyPaths++readCPUFrequencyInfoFromPaths :: [[FilePath]] -> IO CPUFrequencyInfo+readCPUFrequencyInfoFromPaths paths = do+  values <- catMaybes <$> mapM readFrequencyPath paths+  if null values+    then summarizeCPUFrequencies <$> readProcCPUInfoFrequencies+    else pure $ summarizeCPUFrequencies values++discoverPolicyFrequencyPaths :: IO [[FilePath]]+discoverPolicyFrequencyPaths =+  discoverFrequencyPaths+    "/sys/devices/system/cpu/cpufreq"+    ("policy" `isPrefixOf`)+    (\base entry -> base </> entry)++discoverCoreFrequencyPaths :: IO [[FilePath]]+discoverCoreFrequencyPaths =+  discoverFrequencyPaths+    "/sys/devices/system/cpu"+    isCPUCoreDirectory+    (\base entry -> base </> entry </> "cpufreq")++discoverFrequencyPaths :: FilePath -> (FilePath -> Bool) -> (FilePath -> FilePath -> FilePath) -> IO [[FilePath]]+discoverFrequencyPaths base acceptEntry entryDirectory = do+  exists <- doesDirectoryExist base+  if not exists+    then pure []+    else do+      entries <- sort . filter acceptEntry <$> listDirectory base+      filterM (fmap or . mapM doesFileExist) $+        map+          ( \entry ->+              let directory = entryDirectory base entry+               in [directory </> "scaling_cur_freq", directory </> "cpuinfo_cur_freq"]+          )+          entries++isCPUCoreDirectory :: FilePath -> Bool+isCPUCoreDirectory name =+  "cpu" `isPrefixOf` name+    && not (null suffix)+    && all (`elem` (['0' .. '9'] :: String)) suffix+  where+    suffix = drop 3 name++readFrequencyPath :: [FilePath] -> IO (Maybe Integer)+readFrequencyPath [] = pure Nothing+readFrequencyPath (path : rest) = do+  result <- try $ BS8.readFile path+  case result :: Either SomeException BS8.ByteString of+    Right contents ->+      case readMaybe (BS8.unpack $ BS8.takeWhile (`notElem` ['\n', '\r', ' ', '\t']) contents) of+        Just value -> pure $ Just value+        Nothing -> readFrequencyPath rest+    Left _ -> readFrequencyPath rest++readProcCPUInfoFrequencies :: IO [Integer]+readProcCPUInfoFrequencies = do+  result <- try $ BS8.readFile "/proc/cpuinfo"+  pure $ case result :: Either SomeException BS8.ByteString of+    Left _ -> []+    Right contents -> mapMaybe parseMHzLine $ lines $ BS8.unpack contents+  where+    parseMHzLine line = case break (== ':') line of+      (key, ':' : value)+        | words key == ["cpu", "MHz"] ->+            (\mhz -> round (mhz * 1000)) <$> (readMaybe value :: Maybe Double)+      _ -> Nothing++newtype CPUFrequencyInfoChanVar+  = CPUFrequencyInfoChanVar (TChan CPUFrequencyInfo, MVar CPUFrequencyInfo)++-- | Return the process-wide frequency stream. The first caller's interval+-- wins; later widgets reuse the same sampler.+getCPUFrequencyInfoChan :: Double -> TaffyIO (TChan CPUFrequencyInfo)+getCPUFrequencyInfoChan interval = do+  CPUFrequencyInfoChanVar (chan, _) <- setupCPUFrequencyInfoChanVar interval+  pure chan++-- | Read the latest snapshot from the shared frequency sampler.+getCPUFrequencyInfoState :: Double -> TaffyIO CPUFrequencyInfo+getCPUFrequencyInfoState interval = do+  CPUFrequencyInfoChanVar (_, infoVar) <- setupCPUFrequencyInfoChanVar interval+  liftIO $ readMVar infoVar++setupCPUFrequencyInfoChanVar :: Double -> TaffyIO CPUFrequencyInfoChanVar+setupCPUFrequencyInfoChanVar interval = getStateDefault $ do+  wakeupChan <- getWakeupChannelForDelay $ max 0.000001 interval+  ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan+  liftIO $ do+    paths <- discoverCPUFrequencyPaths+    initialInfo <- readCPUFrequencyInfoFromPaths paths+    chan <- newBroadcastTChanIO+    infoVar <- newMVar initialInfo+    pathsVar <- newMVar paths+    void $ forkIO $ forever $ do+      void $ atomically $ readTChan ourWakeupChan+      currentPaths <- readMVar pathsVar+      currentValues <- catMaybes <$> mapM readFrequencyPath currentPaths+      values <-+        if null currentValues+          then do+            refreshedPaths <- discoverCPUFrequencyPaths+            refreshedValues <- catMaybes <$> mapM readFrequencyPath refreshedPaths+            void $ swapMVar pathsVar refreshedPaths+            pure refreshedValues+          else pure currentValues+      info <-+        if null values+          then summarizeCPUFrequencies <$> readProcCPUInfoFrequencies+          else pure $ summarizeCPUFrequencies values+      old <- swapMVar infoVar info+      when (info /= old) $ atomically $ writeTChan chan info+    pure $ CPUFrequencyInfoChanVar (chan, infoVar)

@@ -3,10 +3,20 @@ module System.Taffybar.Information.Memory   ( MemoryInfo (..),     parseMeminfo,+    getMemoryInfoChan,+    getMemoryInfoState,   ) where +import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)+import Control.Concurrent.STM.TChan (TChan, dupTChan, newBroadcastTChanIO, readTChan, writeTChan)+import Control.Monad (forever, void, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.STM (atomically) import qualified Data.ByteString.Char8 as BS8+import System.Taffybar.Context (TaffyIO, getStateDefault)+import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay) import Text.Read (readMaybe)  toMB :: String -> Double@@ -33,6 +43,7 @@     memoryUsed :: Double, -- total - rest     memoryUsedRatio :: Double -- used / total   }+  deriving (Eq, Show)  emptyMemoryInfo :: MemoryInfo emptyMemoryInfo = MemoryInfo 0 0 0 0 0 0 0 0 0 0 0 0@@ -75,3 +86,34 @@         memorySwapUsed = swapUsed,         memorySwapUsedRatio = swapUsedRatio       }++newtype MemoryInfoChanVar+  = MemoryInfoChanVar (TChan MemoryInfo, MVar MemoryInfo)++-- | Return the process-wide memory information stream. The first caller's+-- interval wins; subsequent widgets share the same sampler.+getMemoryInfoChan :: Double -> TaffyIO (TChan MemoryInfo)+getMemoryInfoChan interval = do+  MemoryInfoChanVar (chan, _) <- getMemoryInfoChanVar interval+  pure chan++-- | Read the latest snapshot from the shared memory sampler.+getMemoryInfoState :: Double -> TaffyIO MemoryInfo+getMemoryInfoState interval = do+  MemoryInfoChanVar (_, var) <- getMemoryInfoChanVar interval+  liftIO $ readMVar var++getMemoryInfoChanVar :: Double -> TaffyIO MemoryInfoChanVar+getMemoryInfoChanVar interval = getStateDefault $ do+  wakeupChan <- getWakeupChannelForDelay $ max 0.000001 interval+  ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan+  liftIO $ do+    initialInfo <- parseMeminfo+    chan <- newBroadcastTChanIO+    var <- newMVar initialInfo+    void $ forkIO $ forever $ do+      void $ atomically $ readTChan ourWakeupChan+      info <- parseMeminfo+      old <- swapMVar var info+      when (info /= old) $ atomically $ writeTChan chan info+    pure $ MemoryInfoChanVar (chan, var)

@@ -11,22 +11,177 @@ -- -- NVIDIA GPU information obtained from @nvidia-smi@. module System.Taffybar.Information.Nvidia-  ( NvidiaGpuTemperature (..),+  ( NvidiaGpuInfo (..),+    parseNvidiaGpuInfo,+    readNvidiaGpuInfo,+    readNvidiaGpuInfoWith,+    shouldQueryNvidiaForRuntimeStatuses,+    getNvidiaGpuInfoChan,+    getNvidiaGpuInfoChanWith,+    getNvidiaGpuInfoState,+    getNvidiaGpuInfoStateWith,+    NvidiaGpuTemperature (..),     parseNvidiaGpuTemperatures,     readNvidiaGpuTemperatures,     readNvidiaGpuTemperaturesWith,   ) where +import Control.Concurrent (forkIO)+import Control.Concurrent.MVar+import Control.Concurrent.STM.TChan import Control.Exception (IOException, try)+import Control.Monad (forever, void, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.STM (atomically)+import Data.Char (isHexDigit)+import Data.Foldable (for_) import Data.List (sortOn)-import Data.Maybe (mapMaybe)+import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import System.Directory (listDirectory) import System.Exit (ExitCode (ExitSuccess))+import System.FilePath ((</>)) import System.Process (readProcessWithExitCode)+import System.Taffybar.Context (TaffyIO, getStateDefault)+import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay) import Text.Read (readMaybe)+import Text.XML.Light +-- | A complete snapshot for one NVIDIA GPU.+--+-- Fields that @nvidia-smi@ reports as unavailable are represented by+-- 'Nothing'. Temperatures are in Celsius, power values are in watts, and+-- utilization and fan readings are percentages.+data NvidiaGpuInfo = NvidiaGpuInfo+  { nvidiaInfoIndex :: !Int,+    nvidiaInfoName :: !T.Text,+    nvidiaInfoTemperatureCelsius :: !(Maybe Double),+    nvidiaInfoMemoryTemperatureCelsius :: !(Maybe Double),+    nvidiaInfoTargetTemperatureCelsius :: !(Maybe Double),+    -- | Remaining temperature headroom before the target temperature.+    nvidiaInfoThermalHeadroomCelsius :: !(Maybe Double),+    nvidiaInfoFanSpeedPercent :: !(Maybe Double),+    nvidiaInfoGpuUtilizationPercent :: !(Maybe Double),+    nvidiaInfoMemoryUtilizationPercent :: !(Maybe Double),+    nvidiaInfoMemoryUsedMiB :: !(Maybe Double),+    nvidiaInfoMemoryTotalMiB :: !(Maybe Double),+    nvidiaInfoPowerDrawWatts :: !(Maybe Double),+    nvidiaInfoPowerLimitWatts :: !(Maybe Double),+    nvidiaInfoPerformanceState :: !(Maybe T.Text)+  }+  deriving (Eq, Show)++-- | Parse the XML produced by @nvidia-smi -q -x@.+parseNvidiaGpuInfo :: T.Text -> [NvidiaGpuInfo]+parseNvidiaGpuInfo contents =+  maybe [] (sortOn nvidiaInfoIndex . mapMaybe parseGpu . findElements (unqual "gpu")) $+    parseXMLDoc $+      T.unpack contents+  where+    parseGpu gpu = do+      index <- readElement ["minor_number"] gpu+      name <- elementText ["product_name"] gpu+      pure+        NvidiaGpuInfo+          { nvidiaInfoIndex = index,+            nvidiaInfoName = name,+            nvidiaInfoTemperatureCelsius = readElement ["temperature", "gpu_temp"] gpu,+            nvidiaInfoMemoryTemperatureCelsius = readElement ["temperature", "memory_temp"] gpu,+            nvidiaInfoTargetTemperatureCelsius = readElement ["temperature", "gpu_target_temperature"] gpu,+            nvidiaInfoThermalHeadroomCelsius = readElement ["temperature", "gpu_temp_tlimit"] gpu,+            nvidiaInfoFanSpeedPercent = readElement ["fan_speed"] gpu,+            nvidiaInfoGpuUtilizationPercent = readElement ["utilization", "gpu_util"] gpu,+            nvidiaInfoMemoryUtilizationPercent = readElement ["utilization", "memory_util"] gpu,+            nvidiaInfoMemoryUsedMiB = readElement ["fb_memory_usage", "used"] gpu,+            nvidiaInfoMemoryTotalMiB = readElement ["fb_memory_usage", "total"] gpu,+            nvidiaInfoPowerDrawWatts =+              firstElement+                [ ["gpu_power_readings", "average_power_draw"],+                  ["gpu_power_readings", "instant_power_draw"],+                  ["power_readings", "power_draw"]+                ]+                gpu,+            nvidiaInfoPowerLimitWatts =+              firstElement+                [ ["gpu_power_readings", "current_power_limit"],+                  ["gpu_power_readings", "requested_power_limit"],+                  ["power_readings", "power_limit"]+                ]+                gpu,+            nvidiaInfoPerformanceState = availableElementText ["performance_state"] gpu+          }++-- | Read a rich snapshot using @nvidia-smi@ from @PATH@.+readNvidiaGpuInfo :: IO [NvidiaGpuInfo]+readNvidiaGpuInfo = readNvidiaGpuInfoWith "nvidia-smi"++-- | Read a rich snapshot using the supplied @nvidia-smi@ executable.+-- Returns an empty list when the command is missing, exits unsuccessfully, or+-- is skipped because every detected NVIDIA PCI device is runtime-suspended.+readNvidiaGpuInfoWith :: FilePath -> IO [NvidiaGpuInfo]+readNvidiaGpuInfoWith command =+  fromMaybe [] <$> readNvidiaGpuInfoUpdateWith command++-- | Decide whether querying NVIDIA is safe from the runtime power states of+-- the detected NVIDIA PCI devices. A query is skipped only when at least one+-- device was detected and every device explicitly reports that it is suspended+-- or suspending. Missing and unknown states preserve the historical behavior+-- of running @nvidia-smi@.+shouldQueryNvidiaForRuntimeStatuses :: [Maybe T.Text] -> Bool+shouldQueryNvidiaForRuntimeStatuses [] = True+shouldQueryNvidiaForRuntimeStatuses statuses =+  any (maybe True ((`notElem` lowPowerStatuses) . T.strip)) statuses+  where+    lowPowerStatuses = ["suspended", "suspending"]++newtype NvidiaGpuInfoChanVar+  = NvidiaGpuInfoChanVar (TChan [NvidiaGpuInfo], MVar [NvidiaGpuInfo])++-- | Get a shared broadcast channel of rich NVIDIA snapshots.+--+-- The first call starts one polling producer for the process; subsequent calls+-- reuse it. Consequently, the command and interval from the first call win.+getNvidiaGpuInfoChan :: Double -> TaffyIO (TChan [NvidiaGpuInfo])+getNvidiaGpuInfoChan = getNvidiaGpuInfoChanWith "nvidia-smi"++-- | Like 'getNvidiaGpuInfoChan', using a supplied @nvidia-smi@ executable.+getNvidiaGpuInfoChanWith :: FilePath -> Double -> TaffyIO (TChan [NvidiaGpuInfo])+getNvidiaGpuInfoChanWith command interval = do+  NvidiaGpuInfoChanVar (chan, _) <- setupNvidiaGpuInfoChanVar command interval+  pure chan++-- | Read the latest snapshot cached by 'getNvidiaGpuInfoChan'.+getNvidiaGpuInfoState :: Double -> TaffyIO [NvidiaGpuInfo]+getNvidiaGpuInfoState = getNvidiaGpuInfoStateWith "nvidia-smi"++-- | Like 'getNvidiaGpuInfoState', using a supplied @nvidia-smi@ executable.+getNvidiaGpuInfoStateWith :: FilePath -> Double -> TaffyIO [NvidiaGpuInfo]+getNvidiaGpuInfoStateWith command interval = do+  NvidiaGpuInfoChanVar (_, var) <- setupNvidiaGpuInfoChanVar command interval+  liftIO $ readMVar var++setupNvidiaGpuInfoChanVar :: FilePath -> Double -> TaffyIO NvidiaGpuInfoChanVar+setupNvidiaGpuInfoChanVar command interval = do+  wakeupChan <- getWakeupChannelForDelay $ max 0.000001 interval+  ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan+  getStateDefault $ liftIO $ do+    initialInfo <- fromMaybe [] <$> readNvidiaGpuInfoUpdateWith command+    chan <- newBroadcastTChanIO+    var <- newMVar initialInfo+    void $ forkIO $ forever $ do+      void $ atomically $ readTChan ourWakeupChan+      maybeInfo <- readNvidiaGpuInfoUpdateWith command+      for_ maybeInfo $ \info -> do+        old <- swapMVar var info+        when (info /= old) $ atomically $ writeTChan chan info+    pure $ NvidiaGpuInfoChanVar (chan, var)+ -- | A temperature reported for one NVIDIA GPU.+--+-- This small compatibility type is retained for callers that only need the+-- current core temperature. New code should prefer 'NvidiaGpuInfo'. data NvidiaGpuTemperature = NvidiaGpuTemperature   { nvidiaGpuIndex :: Int,     nvidiaGpuTemperatureCelsius :: Double@@ -47,24 +202,102 @@             <*> readMaybe (T.unpack temperatureText)         _ -> Nothing --- | Read temperatures using @nvidia-smi@ from @PATH@.--- Returns an empty list when the command is missing or exits unsuccessfully.+-- | Read core temperatures using @nvidia-smi@ from @PATH@. readNvidiaGpuTemperatures :: IO [NvidiaGpuTemperature] readNvidiaGpuTemperatures = readNvidiaGpuTemperaturesWith "nvidia-smi" --- | Read temperatures using the supplied @nvidia-smi@ executable.+-- | Read core temperatures using the supplied @nvidia-smi@ executable. readNvidiaGpuTemperaturesWith :: FilePath -> IO [NvidiaGpuTemperature] readNvidiaGpuTemperaturesWith command = do   result <--    try-      ( readProcessWithExitCode-          command-          [ "--query-gpu=index,temperature.gpu",-            "--format=csv,noheader,nounits"-          ]-          ""-      ) ::-      IO (Either IOException (ExitCode, String, String))+    runNvidiaSmi+      command+      [ "--query-gpu=index,temperature.gpu",+        "--format=csv,noheader,nounits"+      ]   pure $ case result of-    Right (ExitSuccess, output, _) -> parseNvidiaGpuTemperatures $ T.pack output-    _ -> []+    NvidiaSmiOutput output -> parseNvidiaGpuTemperatures $ T.pack output+    NvidiaSmiSkipped -> []+    NvidiaSmiFailed -> []++data NvidiaSmiResult+  = NvidiaSmiSkipped+  | NvidiaSmiFailed+  | NvidiaSmiOutput String++readNvidiaGpuInfoUpdateWith :: FilePath -> IO (Maybe [NvidiaGpuInfo])+readNvidiaGpuInfoUpdateWith command = do+  result <- runNvidiaSmi command ["-q", "-x"]+  pure $ case result of+    NvidiaSmiSkipped -> Nothing+    NvidiaSmiFailed -> Just []+    NvidiaSmiOutput output -> Just $ parseNvidiaGpuInfo $ T.pack output++runNvidiaSmi :: FilePath -> [String] -> IO NvidiaSmiResult+runNvidiaSmi command arguments = do+  statuses <- nvidiaPciRuntimeStatuses+  if shouldQueryNvidiaForRuntimeStatuses statuses+    then do+      result <-+        try (readProcessWithExitCode command arguments "") ::+          IO (Either IOException (ExitCode, String, String))+      pure $ case result of+        Right (ExitSuccess, output, _) -> NvidiaSmiOutput output+        _ -> NvidiaSmiFailed+    else pure NvidiaSmiSkipped++nvidiaPciRuntimeStatuses :: IO [Maybe T.Text]+nvidiaPciRuntimeStatuses = do+  let driverPath = "/sys/bus/pci/drivers/nvidia"+  entriesResult <- try (listDirectory driverPath) :: IO (Either IOException [FilePath])+  case entriesResult of+    Left _ -> pure []+    Right entries ->+      traverse (readRuntimeStatus . (driverPath </>)) $+        filter isPciAddress entries++readRuntimeStatus :: FilePath -> IO (Maybe T.Text)+readRuntimeStatus devicePath = do+  result <-+    try (T.strip <$> TIO.readFile (devicePath </> "power/runtime_status")) ::+      IO (Either IOException T.Text)+  pure $ either (const Nothing) Just result++isPciAddress :: FilePath -> Bool+isPciAddress entry =+  case T.split (\character -> character == ':' || character == '.') $ T.pack entry of+    [domain, bus, device, function] ->+      and+        [ T.length domain == 4,+          T.length bus == 2,+          T.length device == 2,+          T.length function == 1,+          all (all isHexDigit . T.unpack) [domain, bus, device, function]+        ]+    _ -> False++elementAt :: [String] -> Element -> Maybe Element+elementAt [] element = Just element+elementAt (name : rest) element =+  findChild (unqual name) element >>= elementAt rest++elementText :: [String] -> Element -> Maybe T.Text+elementText path element = T.strip . T.pack . strContent <$> elementAt path element++availableElementText :: [String] -> Element -> Maybe T.Text+availableElementText path element = do+  value <- elementText path element+  if value `elem` ["", "N/A", "[N/A]"] then Nothing else Just value++readElement :: (Read a) => [String] -> Element -> Maybe a+readElement path element = do+  value <- availableElementText path element+  case reads $ T.unpack value of+    [(number, _)] -> Just number+    _ -> Nothing++firstElement :: (Read a) => [[String]] -> Element -> Maybe a+firstElement paths element =+  case mapMaybe (`readElement` element) paths of+    value : _ -> Just value+    [] -> Nothing

@@ -22,15 +22,25 @@     readAllTemperatures,     readTemperaturesFrom,     convertTemperature,+    getTemperatureInfoChan,+    getTemperatureInfoState,   ) where +import Control.Concurrent (forkIO)+import Control.Concurrent.MVar+import Control.Concurrent.STM.TChan import Control.Exception (SomeException, try)-import Control.Monad (forM)+import Control.Monad (forM, forever, void, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.STM (atomically)+import qualified Data.ByteString.Char8 as BS8 import Data.List (sortOn) import Data.Maybe (catMaybes, fromMaybe) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.FilePath ((</>))+import System.Taffybar.Context (TaffyIO, getStateDefault)+import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay) import Text.Read (readMaybe)  -- | Temperature unit for display@@ -153,10 +163,10 @@   if not exists     then return Nothing     else do-      result <- try $ readFile path :: IO (Either SomeException String)+      result <- try $ BS8.readFile path :: IO (Either SomeException BS8.ByteString)       case result of         Left _ -> return Nothing-        Right content -> return $ Just $ strip content+        Right content -> return $ Just $ strip $ BS8.unpack content   where     strip = dropWhile (== ' ') . reverse . dropWhile (== '\n') . reverse . dropWhile (== ' ') @@ -164,11 +174,11 @@ -- Returns Nothing if the sensor cannot be read readSensorTemperature :: ThermalSensor -> IO (Maybe TemperatureInfo) readSensorTemperature sensor = do-  result <- try $ readFile (sensorPath sensor) :: IO (Either SomeException String)+  result <- try $ BS8.readFile (sensorPath sensor) :: IO (Either SomeException BS8.ByteString)   case result of     Left _ -> return Nothing     Right content ->-      case readMaybe (strip content) :: Maybe Integer of+      case readMaybe (strip $ BS8.unpack content) :: Maybe Integer of         Nothing -> return Nothing         Just milliDegrees ->           return $@@ -193,3 +203,45 @@ readTemperaturesFrom sensors = do   temps <- forM sensors readSensorTemperature   return $ catMaybes temps++newtype TemperatureInfoChanVar+  = TemperatureInfoChanVar (TChan [TemperatureInfo], MVar [TemperatureInfo])++-- | Get a shared broadcast channel containing all discovered temperature+-- readings. The first call starts one producer for the process; subsequent+-- calls reuse it, so the interval from the first call wins.+getTemperatureInfoChan :: Double -> TaffyIO (TChan [TemperatureInfo])+getTemperatureInfoChan interval = do+  TemperatureInfoChanVar (chan, _) <- setupTemperatureInfoChanVar interval+  pure chan++-- | Read the latest snapshot cached by 'getTemperatureInfoChan'.+getTemperatureInfoState :: Double -> TaffyIO [TemperatureInfo]+getTemperatureInfoState interval = do+  TemperatureInfoChanVar (_, var) <- setupTemperatureInfoChanVar interval+  liftIO $ readMVar var++setupTemperatureInfoChanVar :: Double -> TaffyIO TemperatureInfoChanVar+setupTemperatureInfoChanVar interval = getStateDefault $ do+  wakeupChan <- getWakeupChannelForDelay $ max 0.000001 interval+  ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan+  liftIO $ do+    sensors <- discoverSensors+    initialInfo <- sortOn (negate . tempCelsius) <$> readTemperaturesFrom sensors+    chan <- newBroadcastTChanIO+    var <- newMVar initialInfo+    sensorsVar <- newMVar sensors+    void $ forkIO $ forever $ do+      void $ atomically $ readTChan ourWakeupChan+      currentSensors <- readMVar sensorsVar+      sampled <- sortOn (negate . tempCelsius) <$> readTemperaturesFrom currentSensors+      info <-+        if null sampled+          then do+            refreshedSensors <- discoverSensors+            void $ swapMVar sensorsVar refreshedSensors+            sortOn (negate . tempCelsius) <$> readTemperaturesFrom refreshedSensors+          else pure sampled+      old <- swapMVar var info+      when (info /= old) $ atomically $ writeTChan chan info+    pure $ TemperatureInfoChanVar (chan, var)

@@ -26,10 +26,12 @@   ( WakeupEvent (..),     WakeupSchedulerEvent (..),     WakeupChannel (..),+    WakeupSubscription (..),     taffyForeverWithDelay,     getWakeupChannelNanoseconds,     getWakeupChannelSeconds,     getWakeupChannelForDelay,+    subscribeWakeupChannelForDelay,     getWakeupChannel,     getWakeupSchedulerEvents,     getRegisteredWakeupIntervalsNanoseconds,@@ -56,12 +58,14 @@   ( WakeupEvent (..),     WakeupManager,     WakeupSchedulerEvent (..),+    WakeupSubscription (..),     intervalDueAtStepNs,     intervalSecondsToNanoseconds,     nextAlignedWakeupNs,     nextWallAlignedWakeupNs,     registerWakeupInterval,     secondsToNanoseconds,+    subscribeWakeupInterval,     subscribeWakeupSchedulerEvents,   ) import qualified System.Taffybar.Information.Wakeup.Manager as WakeupManager@@ -123,6 +127,16 @@   case intervalSecondsToNanoseconds seconds of     Left err -> fail err     Right intervalNs -> getWakeupChannelNanoseconds intervalNs++-- | Temporarily subscribe to a coordinated interval. Releasing the returned+-- subscription removes an otherwise-unused interval from the scheduler, so a+-- short-lived high-frequency consumer does not increase idle wakeups later.+subscribeWakeupChannelForDelay :: (RealFrac d) => d -> TaffyIO WakeupSubscription+subscribeWakeupChannelForDelay seconds = do+  manager <- getWakeupManager+  case intervalSecondsToNanoseconds seconds of+    Left err -> fail err+    Right intervalNs -> liftIO $ subscribeWakeupInterval manager intervalNs  -- | Type-driven variant of 'getWakeupChannelSeconds'. --

@@ -12,8 +12,10 @@   ( WakeupEvent (..),     WakeupSchedulerEvent (..),     WakeupManager,+    WakeupSubscription (..),     newWakeupManager,     registerWakeupInterval,+    subscribeWakeupInterval,     subscribeWakeupSchedulerEvents,     getRegisteredWakeupIntervalsNanoseconds,     secondsToNanoseconds,@@ -47,6 +49,8 @@     writeTChan,   ) import Control.Exception.Enclosed (catchAny)+import Control.Monad (when)+import Data.IORef (atomicModifyIORef', newIORef) import qualified Data.List as List import qualified Data.Map.Strict as M import Data.Maybe (mapMaybe)@@ -77,9 +81,19 @@   { intervalNanoseconds :: !Word64,     intervalChannel :: TChan WakeupEvent,     intervalNextDueNs :: !Word64,-    intervalTickCount :: !Word64+    intervalTickCount :: !Word64,+    intervalPermanent :: !Bool,+    intervalLeaseCount :: !Int   } +-- | A temporary coordinated wakeup registration. Releasing the final lease+-- removes its interval from the scheduler unless a permanent registration for+-- the same interval also exists. The release action is idempotent.+data WakeupSubscription = WakeupSubscription+  { wakeupSubscriptionChannel :: TChan WakeupEvent,+    releaseWakeupSubscription :: IO ()+  }+ -- Shared wakeup manager state. data WakeupManager = WakeupManager   { -- Approximate wall clock as @monotonic + wakeupRealtimeOffsetNs@.@@ -114,7 +128,11 @@       atomically $ do         registrations <- readTVar (wakeupIntervals manager)         case M.lookup validIntervalNs registrations of-          Just registration -> pure (intervalChannel registration)+          Just registration -> do+            writeTVar+              (wakeupIntervals manager)+              (M.insert validIntervalNs registration {intervalPermanent = True} registrations)+            pure (intervalChannel registration)           Nothing -> do             channel <- newBroadcastTChan             let registration =@@ -126,7 +144,9 @@                           (wakeupRealtimeOffsetNs manager)                           validIntervalNs                           now,-                      intervalTickCount = 0+                      intervalTickCount = 0,+                      intervalPermanent = True,+                      intervalLeaseCount = 0                     }             writeTVar               (wakeupIntervals manager)@@ -135,6 +155,70 @@             -- intervals are not blocked behind an older long sleep.             writeTChan (wakeupRescheduleChan manager) ()             pure channel++-- | Acquire a temporary lease for a coordinated interval. Unlike+-- 'registerWakeupInterval', the interval stops waking the scheduler after the+-- final lease is released (unless it was also registered permanently).+subscribeWakeupInterval :: WakeupManager -> Word64 -> IO WakeupSubscription+subscribeWakeupInterval manager intervalNs =+  case validateIntervalNanoseconds intervalNs of+    Left err -> ioError (userError err)+    Right validIntervalNs -> do+      now <- getMonotonicTimeNSec+      channel <- atomically $ do+        registrations <- readTVar (wakeupIntervals manager)+        case M.lookup validIntervalNs registrations of+          Just registration -> do+            let updated = registration {intervalLeaseCount = intervalLeaseCount registration + 1}+            writeTVar (wakeupIntervals manager) (M.insert validIntervalNs updated registrations)+            pure (intervalChannel registration)+          Nothing -> do+            newChannel <- newBroadcastTChan+            let registration =+                  IntervalRegistration+                    { intervalNanoseconds = validIntervalNs,+                      intervalChannel = newChannel,+                      intervalNextDueNs =+                        nextWallAlignedWakeupNs+                          (wakeupRealtimeOffsetNs manager)+                          validIntervalNs+                          now,+                      intervalTickCount = 0,+                      intervalPermanent = False,+                      intervalLeaseCount = 1+                    }+            writeTVar+              (wakeupIntervals manager)+              (M.insert validIntervalNs registration registrations)+            writeTChan (wakeupRescheduleChan manager) ()+            pure newChannel+      releasedRef <- newIORef False+      let release = do+            shouldRelease <- atomicModifyIORef' releasedRef $ \released -> (True, not released)+            when shouldRelease $ atomically $ releaseIntervalLease manager validIntervalNs+      pure+        WakeupSubscription+          { wakeupSubscriptionChannel = channel,+            releaseWakeupSubscription = release+          }++releaseIntervalLease :: WakeupManager -> Word64 -> STM ()+releaseIntervalLease manager intervalNs = do+  registrations <- readTVar (wakeupIntervals manager)+  case M.lookup intervalNs registrations of+    Nothing -> pure ()+    Just registration -> do+      let remainingLeases = max 0 (intervalLeaseCount registration - 1)+          shouldRemove = remainingLeases == 0 && not (intervalPermanent registration)+          updatedRegistrations+            | shouldRemove = M.delete intervalNs registrations+            | otherwise =+                M.insert+                  intervalNs+                  registration {intervalLeaseCount = remainingLeases}+                  registrations+      writeTVar (wakeupIntervals manager) updatedRegistrations+      when shouldRemove $ writeTChan (wakeupRescheduleChan manager) ()  subscribeWakeupSchedulerEvents :: WakeupManager -> IO (TChan WakeupSchedulerEvent) subscribeWakeupSchedulerEvents manager =

@@ -12,9 +12,9 @@ -- Portability : unportable -- -- This module provides process-level management of @wlsunset@, a--- Wayland day\/night gamma adjustor. It polls for the running state of--- the process and tracks mode cycling (auto → forced high temp →--- forced low temp → auto) via @SIGUSR1@.+-- Wayland day\/night gamma adjustor. While the process is running it uses+-- @pidwait@\/pidfd notification for exit detection; slow polling is only used+-- while waiting for an externally-started process to appear. module System.Taffybar.Information.Wlsunset   ( -- * Types     WlsunsetMode (..),@@ -34,6 +34,7 @@   ) where +import Control.Concurrent (threadDelay) import Control.Concurrent.MVar import Control.Concurrent.STM.TChan import Control.Exception.Enclosed (catchAny)@@ -86,7 +87,8 @@     -- | Low (night) temperature in Kelvin. Used for display only.     -- Should match the @-t@ flag passed to wlsunset (default 4000).     wlsunsetLowTemp :: Int,-    -- | How often (in seconds) to poll for process status.+    -- | How often (in seconds) to look for an externally-started process while+    -- no wlsunset instance is running.     wlsunsetPollIntervalSec :: Int   }   deriving (Eq, Show)@@ -97,7 +99,7 @@       { wlsunsetCommand = "wlsunset",         wlsunsetHighTemp = 6500,         wlsunsetLowTemp = 4000,-        wlsunsetPollIntervalSec = 2+        wlsunsetPollIntervalSec = 30       }  -- | Internal state bundle stored in 'contextState' via 'getStateDefault'.@@ -170,21 +172,23 @@   wakeupChan <- getWakeupChannelSeconds (max 1 (wlsunsetPollIntervalSec cfg))   ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan   taffyFork $ do-    wlsunsetLog DEBUG "Starting wlsunset polling loop"+    wlsunsetLog DEBUG "Starting event-first wlsunset monitor"     let loop = do-          liftIO $ pollWlsunset chan stateVar-          liftIO $ void $ atomically $ readTChan ourWakeupChan+          isRunning <- liftIO $ pollWlsunset chan stateVar+          if isRunning+            then liftIO $ waitForWlsunsetExit (wlsunsetPollIntervalSec cfg)+            else liftIO $ void $ atomically $ readTChan ourWakeupChan           loop     loop   return (chan, stateVar, cfg)  -- | A single poll iteration: check process status, update state, and -- broadcast if changed.-pollWlsunset :: TChan WlsunsetState -> MVar WlsunsetState -> IO ()+pollWlsunset :: TChan WlsunsetState -> MVar WlsunsetState -> IO Bool pollWlsunset chan var = do   pids <- pgrepWlsunset   let isRunning = not (null pids)-  modifyMVar_ var $ \old -> do+  modifyMVar var $ \old -> do     let wasRunning = wlsunsetRunning old         -- When the process freshly appears, reset mode to Auto.         newMode@@ -199,8 +203,15 @@     when (new /= old) $ do       wlsunsetLogF DEBUG "Wlsunset state changed: %s" new       atomically $ writeTChan chan new-    return new+    return (new, isRunning) +-- | Block in procps' pidfd-based waiter until the current process exits.+-- Falling back to the slow discovery loop is safe if pidwait is unavailable.+waitForWlsunsetExit :: Int -> IO ()+waitForWlsunsetExit fallbackIntervalSeconds =+  void (readProcess "pidwait" ["-x", "wlsunset"] "")+    `catchAny` (\_ -> threadDelay $ max 1 fallbackIntervalSeconds * 1000000)+ -- --------------------------------------------------------------------------- -- Actions -- ---------------------------------------------------------------------------@@ -228,19 +239,25 @@  -- | Start the wlsunset process using the configured command. startWlsunset :: WlsunsetConfig -> TaffyIO ()-startWlsunset cfg = liftIO $ do-  wlsunsetLog DEBUG $ "Starting wlsunset: " ++ wlsunsetCommand cfg-  void $ spawnCommand (wlsunsetCommand cfg)+startWlsunset cfg = do+  WlsunsetChanVar (chan, var, _) <- getWlsunsetChanVar cfg+  liftIO $ do+    wlsunsetLog DEBUG $ "Starting wlsunset: " ++ wlsunsetCommand cfg+    void $ spawnCommand (wlsunsetCommand cfg)+    setWlsunsetRunning chan var True  -- | Stop wlsunset by sending @SIGTERM@ (signal 15) to all instances. stopWlsunset :: WlsunsetConfig -> TaffyIO ()-stopWlsunset _cfg = liftIO $ do-  pids <- pgrepWlsunset-  case pids of-    [] -> wlsunsetLog DEBUG "stopWlsunset: wlsunset not running"-    _ -> do-      wlsunsetLog DEBUG "Stopping wlsunset (SIGTERM)"-      mapM_ (signalProcess 15) pids+stopWlsunset cfg = do+  WlsunsetChanVar (chan, var, _) <- getWlsunsetChanVar cfg+  liftIO $ do+    pids <- pgrepWlsunset+    case pids of+      [] -> wlsunsetLog DEBUG "stopWlsunset: wlsunset not running"+      _ -> do+        wlsunsetLog DEBUG "Stopping wlsunset (SIGTERM)"+        mapM_ (signalProcess 15) pids+    setWlsunsetRunning chan var False  -- | Toggle wlsunset: stop it if running, start it if not. toggleWlsunset :: WlsunsetConfig -> TaffyIO ()@@ -265,12 +282,24 @@     modifyMVar_ var $ \old -> do       let new =             old-              { wlsunsetMode = WlsunsetAuto,+              { wlsunsetRunning = True,+                wlsunsetMode = WlsunsetAuto,                 wlsunsetEffectiveHighTemp = highTemp,                 wlsunsetEffectiveLowTemp = lowTemp               }-      atomically $ writeTChan chan new+      when (new /= old) $ atomically $ writeTChan chan new       return new++setWlsunsetRunning :: TChan WlsunsetState -> MVar WlsunsetState -> Bool -> IO ()+setWlsunsetRunning chan var running =+  modifyMVar_ var $ \old -> do+    let new =+          old+            { wlsunsetRunning = running,+              wlsunsetMode = if running then wlsunsetMode old else WlsunsetAuto+            }+    when (new /= old) $ atomically $ writeTChan chan new+    pure new  -- --------------------------------------------------------------------------- -- Command building

@@ -17,7 +17,8 @@ -- ASUS platform profile along with CPU frequency and temperature. -- -- Displays: @\<icon\> \<freq\> \<temp\>@, e.g. @nf-icon 3.2GHz 72°C@.--- Left-click opens a profile selection menu; right-click cycles profiles.+-- Left-click opens one menu with separate AC and battery profile sections;+-- right-click cycles the live profile. module System.Taffybar.Widget.ASUS   ( ASUSWidgetConfig (..),     defaultASUSWidgetConfig,@@ -29,7 +30,10 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader+import DBus (MethodError)+import DBus.Client (Client) import Data.Default (Default (..))+import Data.IORef (newIORef, readIORef, writeIORef) import qualified Data.Text as T import qualified GI.GLib as GLib import qualified GI.Gdk as Gdk@@ -93,8 +97,9 @@     Gtk.containerAdd ebox label     styleCtx <- Gtk.widgetGetStyleContext ebox     Gtk.styleContextAddClass styleCtx "asus-profile"+    renderedRef <- newIORef Nothing -    let updateWidget info = postGUIASync $ do+    let updateWidget info = do           let icon = getTextIcon config (asusProfile info)               freqText =                 if asusShowFreq config@@ -105,9 +110,18 @@                   then T.pack $ printf " %.0f\x00B0C" (asusCpuTempC info)                   else ""               labelText = icon <> freqText <> tempText-          Gtk.labelSetText label labelText-          updateProfileClasses ebox info-          updateTooltip ebox info+              tooltipText = asusTooltipText info+              rendered = (labelText, tooltipText, asusProfile info)+          previous <- readIORef renderedRef+          when (previous /= Just rendered) $ do+            writeIORef renderedRef (Just rendered)+            postGUIASync $ do+              when (fmap (\(oldLabel, _, _) -> oldLabel) previous /= Just labelText) $+                Gtk.labelSetText label labelText+              when (fmap (\(_, _, oldProfile) -> oldProfile) previous /= Just (asusProfile info)) $+                updateProfileClasses ebox info+              when (fmap (\(_, oldTooltip, _) -> oldTooltip) previous /= Just tooltipText) $+                Gtk.widgetSetTooltipText ebox (Just tooltipText)      void $ Gtk.onWidgetRealize ebox $ do       initialInfo <- runReaderT getASUSInfoState ctx@@ -136,20 +150,28 @@   mapM_ (Gtk.styleContextRemoveClass styleCtx) allClasses   Gtk.styleContextAddClass styleCtx currentClass --- | Update tooltip with current profile info.-updateTooltip :: (Gtk.IsWidget w) => w -> ASUSInfo -> IO ()-updateTooltip widget info = do+asusTooltipText :: ASUSInfo -> T.Text+asusTooltipText info =   let profile = asusProfileToString (asusProfile info)-      freqStr = T.pack $ printf "%.2f GHz" (asusCpuFreqGHz info)-      tempStr = T.pack $ printf "%.1f\x00B0C" (asusCpuTempC info)-      tooltipText =-        "Profile: "-          <> profile-          <> "\nCPU Freq: "-          <> freqStr-          <> "\nCPU Temp: "-          <> tempStr-  Gtk.widgetSetTooltipText widget (Just tooltipText)+      acProfile = asusProfileToString (asusACProfile info)+      batteryProfile = asusProfileToString (asusBatteryProfile info)+      powerSource = if asusOnACPower info then "AC power" else "Battery power"+      freqStr = T.pack $ printf "%.1f GHz" (asusCpuFreqGHz info)+      tempStr = T.pack $ printf "%.0f\x00B0C" (asusCpuTempC info)+   in "Active: "+        <> profile+        <> " ("+        <> powerSource+        <> ")\nAC profile: "+        <> acProfile+        <> "\nBattery profile: "+        <> batteryProfile+        <> "\nCPU Freq: "+        <> freqStr+        <> "\nCPU Temp: "+        <> tempStr+        <> "\n\nLeft click: configure profiles"+        <> "\nRight click: cycle active profile"  -- | Set up click handler: left-click opens profile menu, right-click cycles. setupClickHandler :: Context -> Gtk.EventBox -> IO ()@@ -174,38 +196,47 @@           return True         _ -> return False --- | Build and show a popup menu for selecting a profile.+-- | Build and show a popup menu for configuring AC and battery profiles. showProfileMenu :: Context -> Gtk.EventBox -> IO () showProfileMenu ctx ebox = do   currentEvent <- Gtk.getCurrentEvent   currentInfo <- runReaderT getASUSInfoState ctx-  let currentProfile = asusProfile currentInfo    menu <- Gtk.menuNew   Gtk.menuAttachToWidget menu ebox Nothing -  let profiles =-        [ ("Quiet", Quiet),-          ("Balanced", Balanced),-          ("Performance", Performance)-        ]+  let activeProfile = asusProfileToString $ asusProfile currentInfo+      powerSource = if asusOnACPower currentInfo then "AC" else "Battery"+      statusText = "Active: " <> activeProfile <> " (" <> powerSource <> ")" -  forM_ profiles $ \(labelText, profile) -> do-    let prefix =-          if profile == currentProfile-            then "\x2713 " :: T.Text-            else "   "-    item <- Gtk.menuItemNewWithLabel (prefix <> labelText)-    void $ Gtk.onMenuItemActivate item $ do-      let client = systemDBusClient ctx-      result <- setASUSProfile client profile-      case result of-        Left err ->-          asusLogF WARNING "Failed to set ASUS profile: %s" (show err)-        Right () ->-          return ()-    Gtk.menuShellAppend menu item+  statusItem <- Gtk.menuItemNewWithLabel statusText+  Gtk.widgetSetSensitive statusItem False+  Gtk.menuShellAppend menu statusItem +  separator <- Gtk.separatorMenuItemNew+  Gtk.menuShellAppend menu separator++  appendProfileSection+    ctx+    menu+    "AC profile"+    (asusProfile currentInfo)+    (asusACProfile currentInfo)+    (asusOnACPower currentInfo)+    setASUSACProfile++  sectionSeparator <- Gtk.separatorMenuItemNew+  Gtk.menuShellAppend menu sectionSeparator++  appendProfileSection+    ctx+    menu+    "Battery profile"+    (asusProfile currentInfo)+    (asusBatteryProfile currentInfo)+    (not $ asusOnACPower currentInfo)+    setASUSBatteryProfile+   void $     Gtk.onWidgetHide menu $       void $@@ -215,3 +246,57 @@    Gtk.widgetShowAll menu   Gtk.menuPopupAtPointer menu currentEvent++-- | Add a visible section for one source-specific default profile. When the+-- source is currently active, changing its default also changes the live+-- profile.+appendProfileSection ::+  Context ->+  Gtk.Menu ->+  T.Text ->+  ASUSPlatformProfile ->+  ASUSPlatformProfile ->+  Bool ->+  (Client -> ASUSPlatformProfile -> IO (Either MethodError ())) ->+  IO ()+appendProfileSection+  ctx+  menu+  labelText+  liveProfile+  selectedProfile+  sourceIsActive+  setter = do+    let activeSuffix = if sourceIsActive then " (active)" else ""+        sectionLabel =+          labelText+            <> ": "+            <> asusProfileToString selectedProfile+            <> activeSuffix+        profiles = [Quiet, Balanced, Performance]++    headerItem <- Gtk.menuItemNewWithLabel sectionLabel+    Gtk.widgetSetSensitive headerItem False+    Gtk.menuShellAppend menu headerItem++    forM_ profiles $ \profile -> do+      let prefix = if profile == selectedProfile then "  \x2713 " else "     "+          itemLabel = prefix <> asusProfileToString profile+      item <- Gtk.menuItemNewWithLabel itemLabel+      Gtk.menuShellAppend menu item+      void $ Gtk.onMenuItemActivate item $ do+        let client = systemDBusClient ctx+        savedResult <- setter client profile+        case savedResult of+          Left err ->+            asusLogF WARNING "Failed to set saved ASUS profile: %s" (show err)+          Right () -> do+            -- asusd applies any AC/battery default immediately, even if that+            -- power source is inactive. Keep the current source on its existing+            -- profile when editing the other source's default.+            let profileToApply = if sourceIsActive then profile else liveProfile+            activeResult <- setASUSProfile client profileToApply+            case activeResult of+              Left err ->+                asusLogF WARNING "Failed to apply active ASUS profile: %s" (show err)+              Right () -> return ()

@@ -18,6 +18,8 @@     anthropicUsageStackNewWith,     anthropicUsageNew,     anthropicUsageNewWith,+    defaultAnthropicUsageWindowLabelRenderer,+    anthropicUsageWindowLabelParts,     formatAnthropicUsageWindowLabel,     formatAnthropicUsageSummaryLabel,   )@@ -38,7 +40,12 @@ import System.Taffybar.Context (TaffyIO, getStateDefault) import System.Taffybar.Information.AnthropicUsage import System.Taffybar.Util (postGUIASync)-import System.Taffybar.Widget.Util (buildIconLabelBox, widgetSetClassGI)+import System.Taffybar.Widget.Util+  ( UsageWindowLabelParts (..),+    UsageWindowPosition (..),+    buildIconLabelBox,+    widgetSetClassGI,+  ) import Text.Printf (printf)  data AnthropicUsageDisplayMode@@ -80,7 +87,14 @@ data AnthropicUsageStackConfig = AnthropicUsageStackConfig   { anthropicUsageStackInfoConfig :: AnthropicUsageConfig,     anthropicUsageStackDefaultDisplayMode :: AnthropicUsageDisplayMode,-    anthropicUsageStackFallbackText :: T.Text+    anthropicUsageStackFallbackText :: T.Text,+    -- | Arrange the semantic pieces of each stack row. This controls label+    -- order and separators without requiring callers to rebuild the stack,+    -- menu, refresh handling, or usage calculations.+    anthropicUsageStackLabelRenderer ::+      AnthropicUsageWindowSelector ->+      UsageWindowLabelParts ->+      T.Text   }  defaultAnthropicUsageLabelConfig :: AnthropicUsageLabelConfig@@ -100,7 +114,8 @@   AnthropicUsageStackConfig     { anthropicUsageStackInfoConfig = defaultAnthropicUsageConfig,       anthropicUsageStackDefaultDisplayMode = AnthropicUsageDisplayUsed,-      anthropicUsageStackFallbackText = "n/a"+      anthropicUsageStackFallbackText = "n/a",+      anthropicUsageStackLabelRenderer = defaultAnthropicUsageWindowLabelRenderer     }  anthropicUsageNew :: TaffyIO Gtk.Widget@@ -167,7 +182,9 @@       anthropicUsageLabelDefaultDisplayMode = anthropicUsageStackDefaultDisplayMode stackConfig,       anthropicUsageLabelFallbackText = anthropicUsageStackFallbackText stackConfig,       anthropicUsageLabelClass = "anthropic-usage-window-label",-      anthropicUsageLabelFormatter = formatAnthropicUsageWindowLabel selector,+      anthropicUsageLabelFormatter = \displayMode info ->+        anthropicUsageStackLabelRenderer stackConfig selector $+          anthropicUsageWindowLabelParts selector displayMode info,       anthropicUsageLabelUnavailableFormatter = const (anthropicUsageStackFallbackText stackConfig)     } @@ -327,25 +344,80 @@    in (if unavailable then "Claude ! " else "Claude ") <> windows  formatAnthropicUsageWindowLabel :: AnthropicUsageWindowSelector -> AnthropicUsageDisplayMode -> AnthropicUsageInfo -> T.Text-formatAnthropicUsageWindowLabel AnthropicUsageWeeklyWindow displayMode info =-  formatWeeklyWithScopedLabel displayMode info formatAnthropicUsageWindowLabel selector displayMode info =-  maybe "" (formatWindowLabel displayMode) (selectedWindow selector info)+  defaultAnthropicUsageWindowLabelRenderer selector $+    anthropicUsageWindowLabelParts selector displayMode info +-- | Compute the semantic pieces of a window label independently of their+-- presentation order. The weekly value includes the scoped model limit so a+-- renderer can move the complete value without reconstructing it.+anthropicUsageWindowLabelParts ::+  AnthropicUsageWindowSelector ->+  AnthropicUsageDisplayMode ->+  AnthropicUsageInfo ->+  UsageWindowLabelParts+anthropicUsageWindowLabelParts AnthropicUsageWeeklyWindow displayMode info =+  let weekly = anthropicUsageWeeklyWindow info+   in UsageWindowLabelParts+        (anthropicUsageWindowName weekly)+        (formatWeeklyWithScopedValue displayMode info)+        (usageWindowPosition (anthropicUsageGeneratedAt info) <$> anthropicUsageWindowResetAt weekly)+anthropicUsageWindowLabelParts selector displayMode info =+  case selectedWindow selector info of+    Nothing -> UsageWindowLabelParts "" "" Nothing+    Just window ->+      UsageWindowLabelParts+        (anthropicUsageWindowName window)+        (formatWindowValueWithIndicator displayMode window)+        Nothing++-- | Preserve the historical Anthropic layout by default: window name, value,+-- then an optional reset-window position.+defaultAnthropicUsageWindowLabelRenderer ::+  AnthropicUsageWindowSelector ->+  UsageWindowLabelParts ->+  T.Text+defaultAnthropicUsageWindowLabelRenderer _ parts+  | T.null (usageWindowLabelName parts) && T.null (usageWindowLabelValue parts) = ""+  | otherwise =+      usageWindowLabelName parts+        <> " "+        <> usageWindowLabelValue parts+        <> maybe "" ((" " <>) . formatUsageWindowPosition) (usageWindowLabelPosition parts)+ -- | The weekly label with the per-model weekly limit folded in when present,--- e.g. @7d 65%·F45%r@, so the scoped window does not need its own row.+-- so the scoped window does not need its own row. formatWeeklyWithScopedLabel :: AnthropicUsageDisplayMode -> AnthropicUsageInfo -> T.Text formatWeeklyWithScopedLabel displayMode info =+  defaultAnthropicUsageWindowLabelRenderer AnthropicUsageWeeklyWindow $+    anthropicUsageWindowLabelParts AnthropicUsageWeeklyWindow displayMode info++formatWeeklyWithScopedValue :: AnthropicUsageDisplayMode -> AnthropicUsageInfo -> T.Text+formatWeeklyWithScopedValue displayMode info =   let weekly = anthropicUsageWeeklyWindow info       scopedPart window =         "·"           <> T.toUpper (T.take 1 (anthropicUsageWindowName window))           <> formatWindowValue displayMode window-   in anthropicUsageWindowName weekly-        <> " "-        <> formatWindowValue displayMode weekly+   in formatWindowValue displayMode weekly         <> maybe "" scopedPart (anthropicUsageScopedWeeklyWindow info)         <> displayModeIndicator displayMode++usageWindowPosition :: UTCTime -> UTCTime -> UsageWindowPosition+usageWindowPosition generatedAt resetAt =+  UsageWindowPosition day 7+  where+    secondsPerDay = 24 * 60 * 60+    windowStart = addUTCTime (negate $ 7 * secondsPerDay) resetAt+    elapsedPeriods = diffUTCTime generatedAt windowStart / secondsPerDay+    day :: Int+    day = max 0 $ min 7 $ ceiling elapsedPeriods++formatUsageWindowPosition :: UsageWindowPosition -> T.Text+formatUsageWindowPosition position =+  T.pack (show $ usageWindowPositionCurrent position)+    <> "/"+    <> T.pack (show $ usageWindowPositionTotal position)  formatAnthropicUsageTooltip :: AnthropicUsageDisplayMode -> AnthropicUsageSnapshot -> Maybe T.Text formatAnthropicUsageTooltip displayMode snapshot =

@@ -65,7 +65,7 @@ defaultBacklightWidgetConfig :: BacklightWidgetConfig defaultBacklightWidgetConfig =   BacklightWidgetConfig-    { backlightPollingInterval = 2,+    { backlightPollingInterval = 30,       backlightDevice = Nothing,       backlightFormat = "bl: $percent$%",       backlightUnknownFormat = "bl: n/a",

@@ -24,6 +24,7 @@     BatteryClassesConfig (..),     defaultBatteryClassesConfig,     setBatteryStateClasses,+    formatBatteryInfo,     textBatteryNew,     textBatteryNewWithLabelAction,   )@@ -52,7 +53,9 @@ data BatteryWidgetInfo = BWI   { seconds :: Maybe Int64,     percent :: Int,-    status :: String+    status :: String,+    watts :: Double,+    signedWatts :: Double   }   deriving (Eq, Show) @@ -81,7 +84,16 @@           BatteryStateCharging -> "Charging"           BatteryStateDischarging -> "Discharging"           _ -> "✔"-   in BWI {seconds = battTime, percent = battPctNum, status = battStatus}+   in BWI+        { seconds = battTime,+          percent = battPctNum,+          status = battStatus,+          watts = batteryEnergyRate info,+          signedWatts = case batteryState info of+            BatteryStateCharging -> batteryEnergyRate info+            BatteryStateDischarging -> negate $ batteryEnergyRate info+            _ -> 0+        }  -- | Given (maybe summarized) battery info and format: provides the string to display formatBattInfo :: BatteryWidgetInfo -> String -> T.Text@@ -91,22 +103,36 @@         setManyAttrib           [ ("percentage", (show . percent) info),             ("time", formatDuration (seconds info)),-            ("status", status info)+            ("status", status info),+            ("watts", printf "%.1f" (watts info)),+            ("signedWatts", formatSignedWatts $ signedWatts info)           ]           tpl    in render tpl' +formatSignedWatts :: Double -> String+formatSignedWatts value+  | value > 0 = printf "+%.1f" value+  | otherwise = printf "%.1f" value++-- | Format battery information using the placeholders accepted by+-- 'textBatteryNew'.+formatBatteryInfo :: BatteryInfo -> String -> T.Text+formatBatteryInfo = formatBattInfo . getBatteryWidgetInfo+ -- | A simple textual battery widget. The displayed format is specified format -- string where $percentage$ is replaced with the percentage of battery -- remaining and $time$ is replaced with the time until the battery is fully--- charged/discharged.+-- charged/discharged. $status$ is replaced with the charging state and $watts$+-- is replaced with the current energy rate in watts. $signedWatts$ is positive+-- while charging and negative while discharging. textBatteryNew :: String -> TaffyIO Widget textBatteryNew format = textBatteryNewWithLabelAction labelSetter   where     labelSetter label info = do       setBatteryStateClasses def label info       labelSetMarkup label $-        formatBattInfo (getBatteryWidgetInfo info) format+        formatBatteryInfo info format  -- | CSS-threshold configuration for battery level classes. data BatteryClassesConfig = BatteryClassesConfig

@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : System.Taffybar.Widget.CPUFrequency+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- A generic Linux CPU clock-speed widget backed by shared information state.+module System.Taffybar.Widget.CPUFrequency+  ( CPUFrequencyWidgetConfig (..),+    defaultCPUFrequencyWidgetConfig,+    cpuFrequencyNew,+    cpuFrequencyNewWithConfig,+  )+where++import Control.Monad (void, when)+import Control.Monad.IO.Class (liftIO)+import Data.Default (Default (..))+import Data.IORef (newIORef, readIORef, writeIORef)+import qualified Data.Text as T+import qualified GI.Gtk as Gtk+import System.Taffybar.Context (TaffyIO)+import System.Taffybar.Information.CPUFrequency+import System.Taffybar.Util (postGUIASync)+import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew)+import System.Taffybar.Widget.Util (buildIconLabelBox, widgetSetClassGI)+import Text.Printf (printf)++data CPUFrequencyWidgetConfig = CPUFrequencyWidgetConfig+  { cpuFrequencyPollInterval :: Double,+    cpuFrequencyIcon :: T.Text+  }+  deriving (Eq, Show)++defaultCPUFrequencyWidgetConfig :: CPUFrequencyWidgetConfig+defaultCPUFrequencyWidgetConfig =+  CPUFrequencyWidgetConfig+    { cpuFrequencyPollInterval = 10,+      cpuFrequencyIcon = "\xF2DB" -- Font Awesome: microchip+    }++instance Default CPUFrequencyWidgetConfig where+  def = defaultCPUFrequencyWidgetConfig++cpuFrequencyNew :: TaffyIO Gtk.Widget+cpuFrequencyNew = cpuFrequencyNewWithConfig defaultCPUFrequencyWidgetConfig++cpuFrequencyNewWithConfig :: CPUFrequencyWidgetConfig -> TaffyIO Gtk.Widget+cpuFrequencyNewWithConfig config = do+  let interval = cpuFrequencyPollInterval config+  chan <- getCPUFrequencyInfoChan interval+  initialInfo <- getCPUFrequencyInfoState interval+  liftIO $ do+    icon <- Gtk.toWidget =<< Gtk.labelNew (Just $ cpuFrequencyIcon config)+    valueLabel <- Gtk.labelNew Nothing+    value <- Gtk.toWidget valueLabel+    row <- buildIconLabelBox icon value+    _ <- widgetSetClassGI row "cpu-frequency"+    renderedRef <- newIORef Nothing++    let updateWidget info = do+          let rendered = renderCPUFrequency info+          previous <- readIORef renderedRef+          when (previous /= Just rendered) $ do+            writeIORef renderedRef $ Just rendered+            postGUIASync $ do+              Gtk.labelSetText valueLabel $ fst rendered+              Gtk.widgetSetTooltipText row $ Just $ snd rendered++    void $ Gtk.onWidgetRealize row $ updateWidget initialInfo+    Gtk.widgetShowAll row+    Gtk.toWidget =<< channelWidgetNew row chan updateWidget++renderCPUFrequency :: CPUFrequencyInfo -> (T.Text, T.Text)+renderCPUFrequency info =+  case cpuFrequencyAverageGHz info of+    Nothing -> ("n/a", "CPU clock speed unavailable")+    Just average ->+      ( T.pack $ printf "%.1fGHz" average,+        T.pack $+          printf+            "CPU clock average: %.2f GHz\nRange: %.2f-%.2f GHz\n%d frequency policies sampled"+            average+            (maybe average id $ cpuFrequencyMinimumGHz info)+            (maybe average id $ cpuFrequencyMaximumGHz info)+            (cpuFrequencySampleCount info)+      )

@@ -18,10 +18,19 @@ -- available. module System.Taffybar.Widget.CPUMonitor where +import Control.Monad (void) import Control.Monad.IO.Class (liftIO)+import Data.IORef (atomicModifyIORef', newIORef)+import qualified GI.Gdk as Gdk import qualified GI.Gtk import System.Taffybar.Context (TaffyIO)-import System.Taffybar.Information.CPU2 (CPULoad (..), getCPULoadChan)+import System.Taffybar.Information.CPU2+  ( CPULoad (..),+    acquireCPULoadFastRefresh,+    cpuLoadSourceChannel,+    forceCPULoadRefresh,+    getCPULoadSource,+  ) import System.Taffybar.Widget.Generic.ChannelGraph import System.Taffybar.Widget.Generic.Graph import System.Taffybar.Widget.Util (widgetSetClassGI)@@ -37,10 +46,56 @@   String ->   TaffyIO GI.Gtk.Widget cpuMonitorNew cfg interval cpu = do-  chan <- getCPULoadChan cpu interval-  liftIO $-    channelGraphNew cfg chan toSample-      >>= (`widgetSetClassGI` "cpu-monitor")+  cpuMonitorNewWithHover cfg interval (min interval 0.5) cpu++-- | Create a CPU monitor that temporarily requests a faster coordinated+-- sampling cadence while the pointer is over the graph. Pointer leave and+-- widget unrealize both release the request, so the fast scheduler interval+-- does not remain active in the background.+cpuMonitorNewWithHover ::+  -- | Configuration data for the graph.+  GraphConfig ->+  -- | Normal polling period, in seconds.+  Double ->+  -- | Polling period while hovered, in seconds.+  Double ->+  -- | Name of the core to watch (for example, @"cpu"@ or @"cpu0"@).+  String ->+  TaffyIO GI.Gtk.Widget+cpuMonitorNewWithHover cfg interval hoverInterval cpu = do+  source <- getCPULoadSource cpu interval hoverInterval+  liftIO $ do+    graphWidget <- channelGraphNew cfg (cpuLoadSourceChannel source) toSample+    eventBox <- GI.Gtk.eventBoxNew+    GI.Gtk.eventBoxSetVisibleWindow eventBox False+    GI.Gtk.eventBoxSetAboveChild eventBox True+    GI.Gtk.containerAdd eventBox graphWidget+    widget <- GI.Gtk.toWidget eventBox >>= (`widgetSetClassGI` "cpu-monitor")+    releaseRef <- newIORef Nothing++    let beginFastRefresh = do+          currentRelease <- atomicModifyIORef' releaseRef $ \current -> (current, current)+          case currentRelease of+            Just _ -> pure ()+            Nothing -> do+              release <- acquireCPULoadFastRefresh source+              previous <- atomicModifyIORef' releaseRef $ \current -> (Just release, current)+              maybe (pure ()) id previous++        endFastRefresh = do+          release <- atomicModifyIORef' releaseRef $ \current -> (Nothing, current)+          maybe (pure ()) id release++    GI.Gtk.widgetAddEvents+      widget+      [ Gdk.EventMaskEnterNotifyMask,+        Gdk.EventMaskLeaveNotifyMask+      ]+    void $ GI.Gtk.onWidgetEnterNotifyEvent widget $ \_ -> beginFastRefresh >> pure False+    void $ GI.Gtk.onWidgetLeaveNotifyEvent widget $ \_ -> endFastRefresh >> pure False+    void $ GI.Gtk.onWidgetRealize graphWidget $ forceCPULoadRefresh source+    void $ GI.Gtk.onWidgetUnrealize widget endFastRefresh+    pure widget  toSample :: CPULoad -> IO [Double] toSample CPULoad {cpuTotalLoad = totalLoad, cpuSystemLoad = systemLoad} =

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}  -- | -- Module      : System.Taffybar.Widget.NvidiaTemperature@@ -9,11 +10,13 @@ -- Stability   : unstable -- Portability : unportable ----- A widget for displaying NVIDIA GPU temperatures from @nvidia-smi@.+-- NVIDIA GPU temperature widgets backed by @nvidia-smi@. module System.Taffybar.Widget.NvidiaTemperature   ( -- * Combined icon+label widget     nvidiaTemperatureNew,     nvidiaTemperatureNewWith,+    nvidiaTemperatureNewChan,+    nvidiaTemperatureNewChanWith,      -- * Icon-only widget     nvidiaTemperatureIconNew,@@ -22,6 +25,8 @@     -- * Label-only widget     nvidiaTemperatureLabelNew,     nvidiaTemperatureLabelNewWith,+    nvidiaTemperatureLabelNewChan,+    nvidiaTemperatureLabelNewChanWith,      -- * Configuration     NvidiaTemperatureConfig (..),@@ -29,15 +34,22 @@   ) where +import Control.Monad (void, when) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Default (Default (..))+import Data.IORef (newIORef, readIORef, writeIORef) import Data.List (find, intercalate, maximumBy)+import Data.Maybe (catMaybes, mapMaybe) import Data.Ord (comparing) import qualified Data.Text as T import qualified GI.Gtk as Gtk+import System.Taffybar.Context (TaffyIO) import System.Taffybar.Information.Nvidia+import System.Taffybar.Util (postGUIASync)+import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew) import System.Taffybar.Widget.Generic.PollingLabel (pollingLabelNewWithTooltip) import System.Taffybar.Widget.Util (buildIconLabelBox, widgetSetClassGI)+import Text.Printf (printf) import qualified Text.StringTemplate as ST  -- | Configuration for the NVIDIA temperature widget.@@ -46,7 +58,7 @@     nvidiaTemperatureCommand :: FilePath,     -- | GPU index to display. 'Nothing' displays the hottest available GPU.     nvidiaTemperatureGpuIndex :: Maybe Int,-    -- | Label template. Available variables are @gpu@ and @tempC@.+    -- | Label template. Available variables are @gpu@, @name@, and @tempC@.     nvidiaTemperatureFormat :: String,     -- | Text displayed when no temperature is available.     nvidiaTemperatureFallback :: T.Text,@@ -59,7 +71,7 @@ instance Default NvidiaTemperatureConfig where   def = defaultNvidiaTemperatureConfig --- | Default to GPU 0, refreshed every ten seconds.+-- | Default to GPU 0, refreshed every thirty seconds. defaultNvidiaTemperatureConfig :: NvidiaTemperatureConfig defaultNvidiaTemperatureConfig =   NvidiaTemperatureConfig@@ -67,7 +79,7 @@       nvidiaTemperatureGpuIndex = Just 0,       nvidiaTemperatureFormat = "GPU $tempC$\176C",       nvidiaTemperatureFallback = "GPU N/A",-      nvidiaTemperaturePollInterval = 10,+      nvidiaTemperaturePollInterval = 30,       nvidiaTemperatureIcon = "\xF2C9"     } @@ -83,6 +95,19 @@   buildIconLabelBox iconWidget labelWidget     >>= (`widgetSetClassGI` "nvidia-temperature") +-- | Create a combined icon and label widget backed by the shared channel.+nvidiaTemperatureNewChan :: TaffyIO Gtk.Widget+nvidiaTemperatureNewChan = nvidiaTemperatureNewChanWith defaultNvidiaTemperatureConfig++-- | Create a combined icon and label widget backed by the shared channel.+nvidiaTemperatureNewChanWith :: NvidiaTemperatureConfig -> TaffyIO Gtk.Widget+nvidiaTemperatureNewChanWith config = do+  iconWidget <- liftIO $ nvidiaTemperatureIconNewWith config+  labelWidget <- nvidiaTemperatureLabelNewChanWith config+  liftIO $+    buildIconLabelBox iconWidget labelWidget+      >>= (`widgetSetClassGI` "nvidia-temperature")+ -- | Create an icon widget with the default configuration. nvidiaTemperatureIconNew :: (MonadIO m) => m Gtk.Widget nvidiaTemperatureIconNew = nvidiaTemperatureIconNewWith defaultNvidiaTemperatureConfig@@ -99,44 +124,149 @@ nvidiaTemperatureLabelNew :: (MonadIO m) => m Gtk.Widget nvidiaTemperatureLabelNew = nvidiaTemperatureLabelNewWith defaultNvidiaTemperatureConfig --- | Create a label widget that polls @nvidia-smi@.+-- | Create a label widget that polls for rich NVIDIA information. nvidiaTemperatureLabelNewWith :: (MonadIO m) => NvidiaTemperatureConfig -> m Gtk.Widget-nvidiaTemperatureLabelNewWith config = do-  widget <- pollingLabelNewWithTooltip (nvidiaTemperaturePollInterval config) $ do-    temperatures <- readNvidiaGpuTemperaturesWith $ nvidiaTemperatureCommand config-    pure $ case selectTemperature config temperatures of-      Nothing -> (nvidiaTemperatureFallback config, formatTooltip temperatures)-      Just temperature ->-        (formatLabel config temperature, formatTooltip temperatures)+nvidiaTemperatureLabelNewWith config = liftIO $ do+  widget <-+    pollingLabelNewWithTooltip (nvidiaTemperaturePollInterval config) $+      formatWidget config <$> readNvidiaGpuInfoWith (nvidiaTemperatureCommand config)   widgetSetClassGI widget "nvidia-temperature-label" -selectTemperature :: NvidiaTemperatureConfig -> [NvidiaGpuTemperature] -> Maybe NvidiaGpuTemperature-selectTemperature _ [] = Nothing-selectTemperature config temperatures =+-- | Create a label driven by the shared NVIDIA information channel.+nvidiaTemperatureLabelNewChan :: TaffyIO Gtk.Widget+nvidiaTemperatureLabelNewChan = nvidiaTemperatureLabelNewChanWith defaultNvidiaTemperatureConfig++-- | Create a label driven by the shared NVIDIA information channel.+nvidiaTemperatureLabelNewChanWith :: NvidiaTemperatureConfig -> TaffyIO Gtk.Widget+nvidiaTemperatureLabelNewChanWith config = do+  let command = nvidiaTemperatureCommand config+      interval = nvidiaTemperaturePollInterval config+  chan <- getNvidiaGpuInfoChanWith command interval+  initialInfo <- getNvidiaGpuInfoStateWith command interval++  liftIO $ do+    label <- Gtk.labelNew Nothing+    _ <- widgetSetClassGI label "nvidia-temperature-label"+    renderedRef <- newIORef Nothing++    let updateLabel info = do+          let rendered@(labelText, tooltipText) = formatWidget config info+          previous <- readIORef renderedRef+          when (previous /= Just rendered) $ do+            writeIORef renderedRef (Just rendered)+            postGUIASync $ do+              Gtk.labelSetText label labelText+              Gtk.widgetSetTooltipText label tooltipText++    void $ Gtk.onWidgetRealize label $ updateLabel initialInfo+    Gtk.widgetShowAll label+    Gtk.toWidget =<< channelWidgetNew label chan updateLabel++formatWidget :: NvidiaTemperatureConfig -> [NvidiaGpuInfo] -> (T.Text, Maybe T.Text)+formatWidget config info =+  ( maybe (nvidiaTemperatureFallback config) (uncurry $ formatLabel config) $+      selectTemperature config info,+    formatTooltip info+  )++selectTemperature :: NvidiaTemperatureConfig -> [NvidiaGpuInfo] -> Maybe (NvidiaGpuInfo, Double)+selectTemperature config info =   case nvidiaTemperatureGpuIndex config of-    Just index -> find ((== index) . nvidiaGpuIndex) temperatures-    Nothing -> Just $ maximumBy (comparing nvidiaGpuTemperatureCelsius) temperatures+    Just index -> do+      gpu <- find ((== index) . nvidiaInfoIndex) info+      temperature <- nvidiaInfoTemperatureCelsius gpu+      pure (gpu, temperature)+    Nothing ->+      case mapMaybe withTemperature info of+        [] -> Nothing+        temperatures -> Just $ maximumBy (comparing snd) temperatures+  where+    withTemperature gpu = (gpu,) <$> nvidiaInfoTemperatureCelsius gpu -formatLabel :: NvidiaTemperatureConfig -> NvidiaGpuTemperature -> T.Text-formatLabel config temperature =+formatLabel :: NvidiaTemperatureConfig -> NvidiaGpuInfo -> Double -> T.Text+formatLabel config info temperature =   T.pack $ ST.render template   where     template =       ST.setManyAttrib-        [ ("gpu", show $ nvidiaGpuIndex temperature),-          ("tempC", show (round (nvidiaGpuTemperatureCelsius temperature) :: Int))+        [ ("gpu", show $ nvidiaInfoIndex info),+          ("name", T.unpack $ nvidiaInfoName info),+          ("tempC", show (round temperature :: Int))         ]         $ ST.newSTMP         $ nvidiaTemperatureFormat config -formatTooltip :: [NvidiaGpuTemperature] -> Maybe T.Text+formatTooltip :: [NvidiaGpuInfo] -> Maybe T.Text formatTooltip [] = Nothing-formatTooltip temperatures =-  Just $ T.pack $ intercalate "\n" $ map formatOne temperatures+formatTooltip info =+  Just $ T.pack $ intercalate "\n\n" $ map formatGpu info++formatGpu :: NvidiaGpuInfo -> String+formatGpu info = intercalate "\n" $ header : catMaybes detailLines   where-    formatOne temperature =-      "NVIDIA GPU "-        ++ show (nvidiaGpuIndex temperature)-        ++ ": "-        ++ show (round (nvidiaGpuTemperatureCelsius temperature) :: Int)-        ++ "\176C"+    header =+      T.unpack (nvidiaInfoName info)+        ++ " (GPU "+        ++ show (nvidiaInfoIndex info)+        ++ ")"+    detailLines =+      [ temperatureLine info,+        measurementLine "Memory temperature" "\176C" $ nvidiaInfoMemoryTemperatureCelsius info,+        utilizationLine info,+        memoryLine info,+        powerLine info,+        measurementLine "Fan" "%" $ nvidiaInfoFanSpeedPercent info,+        ("Performance state: " ++) . T.unpack <$> nvidiaInfoPerformanceState info+      ]++temperatureLine :: NvidiaGpuInfo -> Maybe String+temperatureLine info = do+  temperature <- nvidiaInfoTemperatureCelsius info+  let details =+        catMaybes+          [ ("target " ++) . formatMeasurement "\176C" <$> nvidiaInfoTargetTemperatureCelsius info,+            ("headroom " ++) . formatMeasurement "\176C" <$> nvidiaInfoThermalHeadroomCelsius info+          ]+      suffix = if null details then "" else " (" ++ intercalate ", " details ++ ")"+  pure $ "Temperature: " ++ formatMeasurement "\176C" temperature ++ suffix++utilizationLine :: NvidiaGpuInfo -> Maybe String+utilizationLine info =+  prefixedValues+    "Utilization: "+    [ ("GPU " ++) . formatMeasurement "%" <$> nvidiaInfoGpuUtilizationPercent info,+      ("memory " ++) . formatMeasurement "%" <$> nvidiaInfoMemoryUtilizationPercent info+    ]++memoryLine :: NvidiaGpuInfo -> Maybe String+memoryLine info =+  case (nvidiaInfoMemoryUsedMiB info, nvidiaInfoMemoryTotalMiB info) of+    (Just used, Just total) ->+      Just $ "VRAM: " ++ formatMeasurement " MiB" used ++ " / " ++ formatMeasurement " MiB" total+    (Just used, Nothing) -> measurementLine "VRAM" " MiB" $ Just used+    _ -> Nothing++powerLine :: NvidiaGpuInfo -> Maybe String+powerLine info =+  case (nvidiaInfoPowerDrawWatts info, nvidiaInfoPowerLimitWatts info) of+    (Just draw, Just limit) ->+      Just $ "Power: " ++ formatMeasurement " W" draw ++ " / " ++ formatMeasurement " W" limit+    (Just draw, Nothing) -> measurementLine "Power" " W" $ Just draw+    _ -> Nothing++measurementLine :: String -> String -> Maybe Double -> Maybe String+measurementLine name unit = fmap $ ((name ++ ": ") ++) . formatMeasurement unit++prefixedValues :: String -> [Maybe String] -> Maybe String+prefixedValues prefix values =+  case catMaybes values of+    [] -> Nothing+    present -> Just $ prefix ++ intercalate ", " present++formatMeasurement :: String -> Double -> String+formatMeasurement unit value = formatNumber value ++ unit++formatNumber :: Double -> String+formatNumber value+  | abs (value - fromIntegral (round value :: Int)) < 0.05 = show (round value :: Int)+  | otherwise = printf "%.1f" value

@@ -18,6 +18,8 @@     openAIUsageStackNewWith,     openAIUsageNew,     openAIUsageNewWith,+    defaultOpenAIUsageWindowLabelRenderer,+    openAIUsageWindowLabelParts,     formatOpenAIUsageWindowLabel,     formatOpenAIUsageSummaryLabel,   )@@ -30,14 +32,20 @@ import Control.Monad (forM_, forever, void) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Reader (ask, runReaderT)-import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe) import qualified Data.Text as T+import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime) import qualified GI.GLib as GLib import qualified GI.Gtk as Gtk import System.Taffybar.Context (TaffyIO, getStateDefault) import System.Taffybar.Information.OpenAIUsage import System.Taffybar.Util (postGUIASync)-import System.Taffybar.Widget.Util (buildIconLabelBox, widgetSetClassGI)+import System.Taffybar.Widget.Util+  ( UsageWindowLabelParts (..),+    UsageWindowPosition (..),+    buildIconLabelBox,+    widgetSetClassGI,+  ) import Text.Printf (printf)  data OpenAIUsageDisplayMode@@ -76,7 +84,14 @@ data OpenAIUsageStackConfig = OpenAIUsageStackConfig   { openAIUsageStackInfoConfig :: OpenAIUsageConfig,     openAIUsageStackDefaultDisplayMode :: OpenAIUsageDisplayMode,-    openAIUsageStackFallbackText :: T.Text+    openAIUsageStackFallbackText :: T.Text,+    -- | Arrange the semantic pieces of each stack row. This controls label+    -- order and separators without requiring callers to rebuild the stack,+    -- menu, refresh handling, or rate-limit calculations.+    openAIUsageStackLabelRenderer ::+      OpenAIUsageWindowSelector ->+      UsageWindowLabelParts ->+      T.Text   }  defaultOpenAIUsageLabelConfig :: OpenAIUsageLabelConfig@@ -96,7 +111,8 @@   OpenAIUsageStackConfig     { openAIUsageStackInfoConfig = defaultOpenAIUsageConfig,       openAIUsageStackDefaultDisplayMode = OpenAIUsageDisplayUsed,-      openAIUsageStackFallbackText = "n/a"+      openAIUsageStackFallbackText = "n/a",+      openAIUsageStackLabelRenderer = defaultOpenAIUsageWindowLabelRenderer     }  openAIUsageNew :: TaffyIO Gtk.Widget@@ -163,7 +179,9 @@       openAIUsageLabelDefaultDisplayMode = openAIUsageStackDefaultDisplayMode stackConfig,       openAIUsageLabelFallbackText = openAIUsageStackFallbackText stackConfig,       openAIUsageLabelClass = "openai-usage-window-label",-      openAIUsageLabelFormatter = formatOpenAIUsageWindowLabel selector,+      openAIUsageLabelFormatter = \displayMode info ->+        openAIUsageStackLabelRenderer stackConfig selector $+          openAIUsageWindowLabelParts selector displayMode info,       openAIUsageLabelUnavailableFormatter = const (openAIUsageStackFallbackText stackConfig)     } @@ -359,18 +377,86 @@       windows =         T.intercalate           " "-          [ fromMaybeText "5h" $ formatWindowLabel displayMode "5h" <$> openAIUsagePrimaryWindow limit,-            fromMaybeText "7d" $ formatWindowLabel displayMode "7d" <$> openAIUsageSecondaryWindow limit+          [ formatOpenAIUsageWindowLabel OpenAIUsagePrimaryWindow displayMode info,+            formatOpenAIUsageWindowLabel OpenAIUsageSecondaryWindow displayMode info           ]       reached = openAIUsageLimitReached limit || isJust (openAIUsageReachedType info)    in (if reached then "AI ! " else "AI ") <> windows  formatOpenAIUsageWindowLabel :: OpenAIUsageWindowSelector -> OpenAIUsageDisplayMode -> OpenAIUsageInfo -> T.Text formatOpenAIUsageWindowLabel selector displayMode info =-  case selectedWindow selector (openAIUsageRateLimit info) of-    Nothing -> windowSelectorFallbackName selector <> " n/a"-    Just window -> formatWindowLabel displayMode (windowSelectorFallbackName selector) window+  defaultOpenAIUsageWindowLabelRenderer selector $+    openAIUsageWindowLabelParts selector displayMode info +-- | Compute the semantic pieces of a window label independently of their+-- presentation order.+openAIUsageWindowLabelParts ::+  OpenAIUsageWindowSelector ->+  OpenAIUsageDisplayMode ->+  OpenAIUsageInfo ->+  UsageWindowLabelParts+openAIUsageWindowLabelParts selector displayMode info =+  case selectedWindow selector limit of+    Nothing+      | selector == OpenAIUsagePrimaryWindow && shortLimitDisabled limit ->+          parts (windowSelectorFallbackName selector) "∞" Nothing+      | otherwise -> parts (windowSelectorFallbackName selector) "n/a" Nothing+    Just window ->+      parts+        (formatWindowName (windowSelectorFallbackName selector) window)+        (formatWindowValueWithIndicator displayMode window)+        (weeklyWindowPosition selector window)+  where+    limit = openAIUsageRateLimit info+    parts = UsageWindowLabelParts++-- | Preserve the historical OpenAI layout by default: ordinary rows show the+-- window name first, while an authoritative weekly position is shown after+-- the value and replaces the redundant weekly name.+defaultOpenAIUsageWindowLabelRenderer ::+  OpenAIUsageWindowSelector ->+  UsageWindowLabelParts ->+  T.Text+defaultOpenAIUsageWindowLabelRenderer _ parts =+  case usageWindowLabelPosition parts of+    Just position ->+      usageWindowLabelValue parts+        <> " "+        <> formatUsageWindowPosition "d" position+    Nothing ->+      usageWindowLabelName parts+        <> " "+        <> usageWindowLabelValue parts++-- | The current day of the semantic weekly window, matching the Anthropic+-- widget's position indicator. OpenAI reports both an absolute @reset_at@ and+-- the remaining seconds at the time of the response; together they recover+-- the snapshot time without consulting the clock while rendering the label.+weeklyWindowPosition :: OpenAIUsageWindowSelector -> OpenAIUsageWindow -> Maybe UsageWindowPosition+weeklyWindowPosition OpenAIUsagePrimaryWindow _ = Nothing+weeklyWindowPosition OpenAIUsageSecondaryWindow window = do+  resetAt <- openAIUsageResetAt window+  resetAfter <- openAIUsageResetAfterSeconds window+  let snapshotAt = addUTCTime (negate $ fromIntegral resetAfter) resetAt+  return $ usageWindowPosition snapshotAt resetAt++usageWindowPosition :: UTCTime -> UTCTime -> UsageWindowPosition+usageWindowPosition snapshotAt resetAt =+  UsageWindowPosition day 7+  where+    secondsPerDay = 24 * 60 * 60+    windowStart = addUTCTime (negate $ 7 * secondsPerDay) resetAt+    elapsedPeriods = diffUTCTime snapshotAt windowStart / secondsPerDay+    day :: Int+    day = max 0 $ min 7 $ ceiling elapsedPeriods++formatUsageWindowPosition :: T.Text -> UsageWindowPosition -> T.Text+formatUsageWindowPosition suffix position =+  T.pack (show $ usageWindowPositionCurrent position)+    <> "/"+    <> T.pack (show $ usageWindowPositionTotal position)+    <> suffix+ formatOpenAIUsageTooltip :: OpenAIUsageDisplayMode -> OpenAIUsageSnapshot -> Maybe T.Text formatOpenAIUsageTooltip displayMode snapshot =   Just $@@ -484,14 +570,15 @@  formatRateLimitMenuLines :: OpenAIUsageDisplayMode -> OpenAIUsageRateLimit -> [T.Text] formatRateLimitMenuLines displayMode limit =-  catMaybes-    [ formatWindowMenuLine displayMode "5h" <$> openAIUsagePrimaryWindow limit,-      formatWindowMenuLine displayMode "7d" <$> openAIUsageSecondaryWindow limit-    ]+  ["5h: unlimited" | shortLimitDisabled limit]+    <> catMaybes+      [ formatWindowMenuLine displayMode "5h" <$> selectedWindow OpenAIUsagePrimaryWindow limit,+        formatWindowMenuLine displayMode "7d" <$> selectedWindow OpenAIUsageSecondaryWindow limit+      ]     <> concat       ( catMaybes-          [ formatWindowTokenMenuLines "5h" <$> openAIUsagePrimaryWindow limit,-            formatWindowTokenMenuLines "7d" <$> openAIUsageSecondaryWindow limit+          [ formatWindowTokenMenuLines "5h" <$> selectedWindow OpenAIUsagePrimaryWindow limit,+            formatWindowTokenMenuLines "7d" <$> selectedWindow OpenAIUsageSecondaryWindow limit           ]       )     <> [formatRateLimitStatus limit]@@ -541,11 +628,12 @@   let windows =         T.intercalate           ", "-          ( mapMaybe-              (uncurry (formatWindow displayMode))-              [ ("short", openAIUsagePrimaryWindow limit),-                ("long", openAIUsageSecondaryWindow limit)-              ]+          ( ["5h unlimited" | shortLimitDisabled limit]+              <> mapMaybe+                (uncurry (formatWindow displayMode))+                [ ("short", selectedWindow OpenAIUsagePrimaryWindow limit),+                  ("long", selectedWindow OpenAIUsageSecondaryWindow limit)+                ]           )       status         | openAIUsageLimitReached limit = "reached"@@ -566,12 +654,6 @@       <> maybe "" ((" / " <>) . formatDuration) (openAIUsageWindowDurationSeconds window)       <> maybe "" ((", resets in " <>) . formatDuration) (openAIUsageResetAfterSeconds window) -formatWindowLabel :: OpenAIUsageDisplayMode -> T.Text -> OpenAIUsageWindow -> T.Text-formatWindowLabel displayMode fallbackName window =-  formatWindowName fallbackName window-    <> " "-    <> formatWindowValueWithIndicator displayMode window- formatWindowName :: T.Text -> OpenAIUsageWindow -> T.Text formatWindowName fallbackName window =   maybe fallbackName formatDuration (openAIUsageWindowDurationSeconds window)@@ -624,8 +706,29 @@   | otherwise = T.pack $ show count  selectedWindow :: OpenAIUsageWindowSelector -> OpenAIUsageRateLimit -> Maybe OpenAIUsageWindow-selectedWindow OpenAIUsagePrimaryWindow = openAIUsagePrimaryWindow-selectedWindow OpenAIUsageSecondaryWindow = openAIUsageSecondaryWindow+selectedWindow OpenAIUsagePrimaryWindow limit+  | primaryWindowIsLong limit && isNothing (openAIUsageSecondaryWindow limit) = Nothing+  | otherwise = openAIUsagePrimaryWindow limit+selectedWindow OpenAIUsageSecondaryWindow limit =+  case openAIUsageSecondaryWindow limit of+    Just window -> Just window+    Nothing+      | primaryWindowIsLong limit -> openAIUsagePrimaryWindow limit+      | otherwise -> Nothing++-- Codex temporarily omits the 5-hour window when that limit is disabled. In+-- that state the 7-day window moves into the API's primary slot instead of+-- leaving a placeholder there, so identify the window by its duration before+-- assigning it to the widget's semantic 5-hour and 7-day rows.+primaryWindowIsLong :: OpenAIUsageRateLimit -> Bool+primaryWindowIsLong limit =+  case openAIUsagePrimaryWindow limit >>= openAIUsageWindowDurationSeconds of+    Just duration -> duration >= 24 * 60 * 60+    Nothing -> False++shortLimitDisabled :: OpenAIUsageRateLimit -> Bool+shortLimitDisabled limit =+  primaryWindowIsLong limit && isNothing (openAIUsageSecondaryWindow limit)  windowSelectorFallbackName :: OpenAIUsageWindowSelector -> T.Text windowSelectorFallbackName OpenAIUsagePrimaryWindow = "5h"

@@ -813,6 +813,40 @@     Gtk.widgetShowAll menu     Gtk.menuPopupAtPointer menu currentEvent +-- | State machine for the polled hover-expand mechanism.+--+-- The pointer position is polled directly (see 'pointerWithinWidget') rather+-- than inferred from crossing events, so synthetic crossing events (grabs,+-- child transitions) cannot corrupt hover state. Timestamps are+-- 'GLib.getMonotonicTime' microseconds.+data HoverPollState+  = HoverIdle+  | HoverPendingExpand Int64+  | HoverExpanded+  | HoverPendingCollapse Int64++-- | Return whether the pointer is currently within the bounds of the widget's+-- window, measured directly from GDK rather than inferred from crossing events.+--+-- This is used as ground truth to resynchronize hover state that can be+-- corrupted by synthetic crossing events (grabs, child transitions).+pointerWithinWidget :: (Gtk.IsWidget w) => w -> IO Bool+pointerWithinWidget widget = do+  maybeWindow <- Gtk.widgetGetWindow widget+  case maybeWindow of+    Nothing -> return False+    Just window -> do+      display <- Gdk.windowGetDisplay window+      seat <- Gdk.displayGetDefaultSeat display+      maybePointer <- Gdk.seatGetPointer seat+      case maybePointer of+        Nothing -> return False+        Just pointer -> do+          (_, x, y, _) <- Gdk.windowGetDevicePosition window pointer+          width <- Gdk.windowGetWidth window+          height <- Gdk.windowGetHeight window+          return (x >= 0 && y >= 0 && x < width && y < height)+ -- | Build a collapsible StatusNotifierItem tray with priority editing controls -- and persisted priority state. sniTrayPrioritizedCollapsibleNew :: TaffyIO Gtk.Widget@@ -861,8 +895,8 @@     prioritiesRef <- newIORef persistedPriorities     expandedRef <- newIORef collapsibleSNITrayStartExpanded     hoverExpandedRef <- newIORef False-    hoverInsideRef <- newIORef False-    hoverSerialRef <- newIORef (0 :: Int)+    hoverPollStateRef <- newIORef HoverIdle+    hoverPollActiveRef <- newIORef False     animationSerialRef <- newIORef (0 :: Int)     animationActiveRef <- newIORef False     priorityEditModeRef <- newIORef prioritizedCollapsibleSNITrayStartPriorityEditMode@@ -1145,22 +1179,69 @@                   targetVisibleCount <- computeNaturalVisibleCount (length children)                   animateTrayExtentTo tray targetVisibleCount -        scheduleHoverExpanded shouldExpand delayMs = do-          modifyIORef' hoverSerialRef (+ 1)-          hoverSerial <- readIORef hoverSerialRef-          void $-            GLib.timeoutAdd GLib.PRIORITY_DEFAULT delayMs $ do-              currentSerial <- readIORef hoverSerialRef-              hoverInside <- readIORef hoverInsideRef-              when-                ( currentSerial == hoverSerial-                    && hoverInside == shouldExpand-                )-                (setHoverExpanded shouldExpand)-              return False+        hoverPollIntervalMs = 100 :: Word32 +        engageHoverPoll = do+          state <- readIORef hoverPollStateRef+          case state of+            HoverIdle -> do+              now <- GLib.getMonotonicTime+              writeIORef hoverPollStateRef (HoverPendingExpand now)+            _ -> return ()+          pollActive <- readIORef hoverPollActiveRef+          unless pollActive $ do+            writeIORef hoverPollActiveRef True+            void $+              GLib.timeoutAdd GLib.PRIORITY_DEFAULT hoverPollIntervalMs $ do+                keepPolling <- stepHoverPoll+                unless keepPolling $ writeIORef hoverPollActiveRef False+                return keepPolling++        stepHoverPoll = do+          state <- readIORef hoverPollStateRef+          now <- GLib.getMonotonicTime+          let expandDelayUs =+                fromIntegral prioritizedCollapsibleSNITrayHoverExpandDelayMs * 1000 :: Int64+              collapseDelayUs =+                fromIntegral prioritizedCollapsibleSNITrayHoverCollapseDelayMs * 1000 :: Int64+          case state of+            HoverIdle -> return False+            HoverPendingExpand since -> do+              inside <- pointerWithinWidget outerEventBox+              if not inside+                then do+                  writeIORef hoverPollStateRef HoverIdle+                  return False+                else+                  if now - since >= expandDelayUs+                    then do+                      setHoverExpanded True+                      writeIORef hoverPollStateRef HoverExpanded+                      return True+                    else return True+            HoverExpanded -> do+              inside <- pointerWithinWidget outerEventBox+              if inside+                then return True+                else do+                  writeIORef hoverPollStateRef (HoverPendingCollapse now)+                  return True+            HoverPendingCollapse since -> do+              inside <- pointerWithinWidget outerEventBox+              if inside+                then do+                  writeIORef hoverPollStateRef HoverExpanded+                  return True+                else+                  if now - since >= collapseDelayUs+                    then do+                      setHoverExpanded False+                      writeIORef hoverPollStateRef HoverIdle+                      return False+                    else return True+         cancelHoverExpansion = do-          modifyIORef' hoverSerialRef (+ 1)+          writeIORef hoverPollStateRef HoverIdle           writeIORef hoverExpandedRef False           modifyIORef' animationSerialRef (+ 1)           writeIORef animationActiveRef False@@ -1179,7 +1260,7 @@               visibleCount =                 max 0 (min totalCount naturalVisibleCount)               hiddenCount = max 0 (totalCount - visibleCount)-              hiddenCountText = T.pack (show hiddenCount)+              hiddenCountText = T.pack ('+' : show hiddenCount)               priorityForInfo info =                 itemPriorityFromMap                   priorityMin@@ -1325,22 +1406,9 @@         else return False      when prioritizedCollapsibleSNITrayHoverExpand $ do-      Gtk.widgetAddEvents-        outerEventBox-        [ Gdk.EventMaskEnterNotifyMask,-          Gdk.EventMaskLeaveNotifyMask-        ]       Gtk.widgetAddEvents settingsToggle [Gdk.EventMaskEnterNotifyMask]-      _ <- Gtk.onWidgetEnterNotifyEvent outerEventBox $ \_event -> do-        writeIORef hoverInsideRef True-        return False-      _ <- Gtk.onWidgetLeaveNotifyEvent outerEventBox $ \_event -> do-        writeIORef hoverInsideRef False-        scheduleHoverExpanded False prioritizedCollapsibleSNITrayHoverCollapseDelayMs-        return False       _ <- Gtk.onWidgetEnterNotifyEvent settingsToggle $ \_event -> do-        writeIORef hoverInsideRef True-        scheduleHoverExpanded True prioritizedCollapsibleSNITrayHoverExpandDelayMs+        engageHoverPoll         return False       return () 

@@ -18,6 +18,8 @@   ( -- * Combined icon+label widget     temperatureNew,     temperatureNewWith,+    temperatureNewChan,+    temperatureNewChanWith,      -- * Icon-only widget     temperatureIconNew,@@ -26,6 +28,8 @@     -- * Label-only widget     temperatureLabelNew,     temperatureLabelNewWith,+    temperatureLabelNewChan,+    temperatureLabelNewChanWith,      -- * Configuration     TemperatureConfig (..),@@ -36,12 +40,17 @@   ) where +import Control.Monad (void, when) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Default (Default (..))+import Data.IORef (newIORef, readIORef, writeIORef) import Data.List (intercalate) import qualified Data.Text as T import qualified GI.Gtk as Gtk+import System.Taffybar.Context (TaffyIO) import System.Taffybar.Information.Temperature+import System.Taffybar.Util (postGUIASync)+import System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew) import System.Taffybar.Widget.Generic.PollingLabel (pollingLabelNewWithTooltip) import System.Taffybar.Widget.Util (buildIconLabelBox, widgetSetClassGI) import qualified Text.StringTemplate as ST@@ -57,10 +66,13 @@     tempWarningThreshold :: Double,     -- | Temperature (in Celsius) at which to show critical style (default: 85)     tempCriticalThreshold :: Double,-    -- | How often to poll for temperature updates, in seconds (default: 10)+    -- | How often to poll for temperature updates, in seconds (default: 30)     tempPollInterval :: Double,     -- | Filter function to select which sensors to monitor (default: all)     tempSensorFilter :: ThermalSensor -> Bool,+    -- | Select additional sensors to include only in the tooltip. Sensors+    -- selected by 'tempSensorFilter' are always included (default: none).+    tempTooltipSensorFilter :: ThermalSensor -> Bool,     -- | How to aggregate multiple sensor readings (default: maximum)     tempAggregation :: [TemperatureInfo] -> Maybe Double,     -- | Nerd font icon character (default U+F2C9, nf-fa-thermometer).@@ -78,8 +90,9 @@       tempUnit = Celsius,       tempWarningThreshold = 70,       tempCriticalThreshold = 85,-      tempPollInterval = 10,+      tempPollInterval = 30,       tempSensorFilter = const True,+      tempTooltipSensorFilter = const False,       tempAggregation = \temps ->         if null temps           then Nothing@@ -99,6 +112,19 @@   buildIconLabelBox iconWidget labelWidget     >>= (`widgetSetClassGI` "temperature") +-- | Create a combined icon+label widget backed by the shared channel.+temperatureNewChan :: TaffyIO Gtk.Widget+temperatureNewChan = temperatureNewChanWith defaultTemperatureConfig++-- | Create a combined icon+label widget backed by the shared channel.+temperatureNewChanWith :: TemperatureConfig -> TaffyIO Gtk.Widget+temperatureNewChanWith config = do+  iconWidget <- liftIO $ temperatureIconNewWith config+  labelWidget <- temperatureLabelNewChanWith config+  liftIO $+    buildIconLabelBox iconWidget labelWidget+      >>= (`widgetSetClassGI` "temperature")+ -- | Create a temperature icon widget with default configuration. temperatureIconNew :: (MonadIO m) => m Gtk.Widget temperatureIconNew = temperatureIconNewWith defaultTemperatureConfig@@ -115,29 +141,59 @@ temperatureLabelNew :: (MonadIO m) => m Gtk.Widget temperatureLabelNew = temperatureLabelNewWith defaultTemperatureConfig --- | Create a temperature label widget with custom configuration.+-- | Create a polling temperature label with custom configuration. temperatureLabelNewWith :: (MonadIO m) => TemperatureConfig -> m Gtk.Widget temperatureLabelNewWith config = liftIO $ do-  -- Discover sensors once at startup, filtered by config-  allSensors <- discoverSensors-  let sensors = filter (tempSensorFilter config) allSensors--  widget <- pollingLabelNewWithTooltip (tempPollInterval config) $ do-    temps <- readTemperaturesFiltered sensors-    case tempAggregation config temps of-      Nothing -> return (T.pack "N/A", Nothing)-      Just tempC -> do-        let tempF = convertTemperature Fahrenheit tempC-            tempK = convertTemperature Kelvin tempC-            tempDisplay = convertTemperature (tempUnit config) tempC-            labelText = formatTemperature config tempDisplay tempC tempF tempK-            tooltipText = formatTooltip temps-        return (labelText, Just tooltipText)+  widget <-+    pollingLabelNewWithTooltip (tempPollInterval config) $+      formatTemperatureInfo config <$> readAllTemperatures   widgetSetClassGI widget "temperature-label"++-- | Create a channel-driven temperature label with the default configuration.+temperatureLabelNewChan :: TaffyIO Gtk.Widget+temperatureLabelNewChan = temperatureLabelNewChanWith defaultTemperatureConfig++-- | Create a channel-driven temperature label with custom configuration.+-- Sensor discovery and polling are shared by every channel-driven widget.+temperatureLabelNewChanWith :: TemperatureConfig -> TaffyIO Gtk.Widget+temperatureLabelNewChanWith config = do+  chan <- getTemperatureInfoChan $ tempPollInterval config+  initialInfo <- getTemperatureInfoState $ tempPollInterval config++  liftIO $ do+    label <- Gtk.labelNew Nothing+    _ <- widgetSetClassGI label "temperature-label"+    renderedRef <- newIORef Nothing++    let updateLabel info = do+          let rendered@(labelText, tooltipText) = formatTemperatureInfo config info+          previous <- readIORef renderedRef+          when (previous /= Just rendered) $ do+            writeIORef renderedRef (Just rendered)+            postGUIASync $ do+              Gtk.labelSetText label labelText+              Gtk.widgetSetTooltipText label tooltipText++    void $ Gtk.onWidgetRealize label $ updateLabel initialInfo+    Gtk.widgetShowAll label+    Gtk.toWidget =<< channelWidgetNew label chan updateLabel++formatTemperatureInfo :: TemperatureConfig -> [TemperatureInfo] -> (T.Text, Maybe T.Text)+formatTemperatureInfo config allTemperatures =+  case tempAggregation config temperatures of+    Nothing -> ("N/A", tooltipText)+    Just tempC ->+      let tempF = convertTemperature Fahrenheit tempC+          tempK = convertTemperature Kelvin tempC+          tempDisplay = convertTemperature (tempUnit config) tempC+       in (formatTemperature config tempDisplay tempC tempF tempK, tooltipText)   where-    readTemperaturesFiltered :: [ThermalSensor] -> IO [TemperatureInfo]-    readTemperaturesFiltered sensors =-      filter (\t -> tempSensor t `elem` sensors) <$> readAllTemperatures+    includedInLabel = tempSensorFilter config . tempSensor+    includedInTooltip info =+      includedInLabel info || tempTooltipSensorFilter config (tempSensor info)+    temperatures = filter includedInLabel allTemperatures+    tooltipTemperatures = filter includedInTooltip allTemperatures+    tooltipText = formatTooltip tooltipTemperatures  -- | Format the temperature label using the template formatTemperature :: TemperatureConfig -> Double -> Double -> Double -> Double -> T.Text@@ -156,10 +212,11 @@     formatDouble :: Double -> String     formatDouble d = show (round d :: Int) --- | Format tooltip showing all sensor readings-formatTooltip :: [TemperatureInfo] -> T.Text+-- | Format tooltip showing all selected sensor readings.+formatTooltip :: [TemperatureInfo] -> Maybe T.Text+formatTooltip [] = Nothing formatTooltip temps =-  T.pack $ intercalate "\n" $ map formatSensor temps+  Just $ T.pack $ intercalate "\n" $ map formatSensor temps   where     formatSensor info =       sensorName (tempSensor info)

@@ -41,6 +41,25 @@ import System.Taffybar.Util import Text.Printf +-- | A position within a usage window, such as day 3 of a 7-day window.+-- Keeping this semantic rather than preformatted lets widget configurations+-- choose their own compactness, separators, and ordering.+data UsageWindowPosition = UsageWindowPosition+  { usageWindowPositionCurrent :: Int,+    usageWindowPositionTotal :: Int+  }+  deriving (Eq, Show)++-- | Preformatted semantic pieces of a usage-window label. Widget-specific+-- code computes the values; callers can arrange them without duplicating the+-- usage and reset-window calculations.+data UsageWindowLabelParts = UsageWindowLabelParts+  { usageWindowLabelName :: T.Text,+    usageWindowLabelValue :: T.Text,+    usageWindowLabelPosition :: Maybe UsageWindowPosition+  }+  deriving (Eq, Show)+ -- | Common record used for window icon widgets in workspace switchers. data WindowIconWidget a = WindowIconWidget   { iconContainer :: Gtk.EventBox,

@@ -1,6 +1,6 @@ cabal-version: 3.4 name: taffybar-version: 7.2.6+version: 7.2.7 synopsis: A desktop bar similar to xmobar, but with more GUI description: Taffybar is a desktop status bar with GTK widgets for window   manager state, system information, tray icons, and custom user modules.@@ -75,7 +75,7 @@                , data-default >= 0.7 && < 0.9                , dbus >= 1.2.11 && < 2                , dbus-hslogger >= 0.1.1.1 && < 0.2-               , dbus-menu >= 0.1.3.3 && < 0.2+               , dbus-menu >= 0.1.3.4 && < 0.2                , directory >= 1.3 && < 1.4                , disk-free-space >= 0.1.0.1 && < 0.2                , dyre >= 0.9.0 && < 0.10@@ -152,6 +152,7 @@                  , System.Taffybar.Information.Battery                  , System.Taffybar.Information.Bluetooth                  , System.Taffybar.Information.CPU2+                 , System.Taffybar.Information.CPUFrequency                  , System.Taffybar.Information.ChromeWindowInfo                  , System.Taffybar.Information.Crypto                  , System.Taffybar.Information.DiskIO@@ -199,6 +200,7 @@                  , System.Taffybar.Widget.BatteryTextIcon                  , System.Taffybar.Widget.Bluetooth                  , System.Taffybar.Widget.CPUMonitor+                 , System.Taffybar.Widget.CPUFrequency                  , System.Taffybar.Widget.CommandRunner                  , System.Taffybar.Widget.CoordinatedClock                  , System.Taffybar.Widget.Crypto@@ -394,9 +396,12 @@   hs-source-dirs: test/unit   main-is: unit-tests.hs   other-modules: UnitSpec+               , DBusMenuSpec                , System.Taffybar.AuthSpec                , System.Taffybar.AppearanceSpec                , System.Taffybar.ContextSpec+               , System.Taffybar.Information.ASUSSpec+               , System.Taffybar.Information.CPUFrequencySpec                , System.Taffybar.Information.CryptoSpec                , System.Taffybar.Information.LayoutSpec                , System.Taffybar.Information.NvidiaSpec@@ -406,6 +411,9 @@                , System.Taffybar.Information.WakeupSpec                , System.Taffybar.SimpleConfigSpec                , System.Taffybar.WidgetPrioritySpec+               , System.Taffybar.Widget.AnthropicUsageSpec+               , System.Taffybar.Widget.BatterySpec+               , System.Taffybar.Widget.OpenAIUsageSpec                , System.Taffybar.Widget.SNITray.PrioritizedCollapsibleSpec                , System.Taffybar.Widget.Workspaces.ChannelSpec                , System.Taffybar.Widget.WindowsSpec@@ -413,6 +421,7 @@                , bytestring                , containers                , dbus+               , dbus-menu                , directory                , JuicyPixels                , filepath@@ -425,6 +434,7 @@                , status-notifier-item                , taffybar                , taffybar:testlib+               , time                , typed-process                , unix                , unliftio

@@ -84,6 +84,8 @@ 	padding-left: 4px; 	padding-right: 4px; 	margin-left: 3px;+	opacity: 0.6;+	transition: opacity .15s ease, background-color .2s ease, border-color .2s ease; }  .sni-tray-expand-toggle:hover,@@ -91,10 +93,22 @@ .sni-tray-settings-toggle:hover { 	background-color: rgba(255, 255, 255, 0.15); 	border-color: rgba(255, 255, 255, 0.30);+	opacity: 1; }  .sni-tray-overflow-count-label { 	min-width: 12px;+	font-size: 90%;+	padding: 0 2px;+}++.sni-tray-collapsible {+	border-radius: 6px;+	transition: background-color .25s ease;+}++.sni-tray-collapsible-expanded {+	background-color: rgba(255, 255, 255, 0.06); }  .sni-tray-edit-toggle-active,

@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++module DBusMenuSpec (spec) where++import DBus (toVariant)+import DBusMenu+  ( LayoutNode (..),+    MenuItemShape,+    menuItemShape,+  )+import DBusMenu.Reconcile+  ( ReconcileAction (..),+    planReconciliation,+  )+import Data.Int (Int32)+import Data.Map.Strict qualified as Map+import Test.Hspec++spec :: Spec+spec = do+  describe "DBusMenu reconciliation" $ do+    it "reuses IDs whose GTK shape is unchanged" $ do+      let original = leaf 1 "Before" True+          updated = leaf 1 "After" False+          existing :: Map.Map Int32 MenuItemShape+          existing = Map.singleton 1 (menuItemShape original)+      planReconciliation existing [(1, menuItemShape updated)]+        `shouldBe` [ReuseItem 1]++    it "reuses stable IDs across additions, removals, and reordering" $ do+      let shape = menuItemShape (leaf 0 "" True)+          existing :: Map.Map Int32 MenuItemShape+          existing = Map.fromList [(1, shape), (2, shape), (3, shape)]+      planReconciliation existing [(3, shape), (2, shape), (4, shape)]+        `shouldBe` [ReuseItem 3, ReuseItem 2, BuildItem 4]++    it "builds a replacement when an item's GTK shape changes" $ do+      let original = leaf 1 "Leaf" True+          updated = submenu 1 "Submenu"+          existing :: Map.Map Int32 MenuItemShape+          existing = Map.singleton 1 (menuItemShape original)+      planReconciliation existing [(1, menuItemShape updated)]+        `shouldBe` [BuildItem 1]++    it "does not reuse the same widget for a duplicate desired ID" $ do+      let shape = menuItemShape (leaf 1 "Leaf" True)+          existing :: Map.Map Int32 MenuItemShape+          existing = Map.singleton 1 shape+      planReconciliation existing [(1, shape), (1, shape)]+        `shouldBe` [ReuseItem 1, BuildItem 1]++leaf :: Int -> String -> Bool -> LayoutNode+leaf itemId label enabled =+  LayoutNode+    { lnId = fromIntegral itemId,+      lnProps =+        Map.fromList+          [ ("label", toVariant label),+            ("enabled", toVariant enabled)+          ],+      lnChildren = []+    }++submenu :: Int -> String -> LayoutNode+submenu itemId label =+  LayoutNode+    { lnId = fromIntegral itemId,+      lnProps =+        Map.fromList+          [ ("label", toVariant label),+            ("children-display", toVariant ("submenu" :: String))+          ],+      lnChildren = []+    }

@@ -0,0 +1,14 @@+module System.Taffybar.Information.ASUSSpec (spec) where++import System.Taffybar.Information.ASUS+import Test.Hspec++spec :: Spec+spec = describe "ASUS platform profile DBus encoding" $ do+  it "decodes the asusd 6 profile values" $+    map asusProfileFromUInt [0, 1, 2, 99]+      `shouldBe` [Just Balanced, Just Performance, Just Quiet, Nothing]++  it "encodes the asusd 6 profile values" $+    map asusProfileToUInt [Balanced, Performance, Quiet]+      `shouldBe` [0, 1, 2]

@@ -0,0 +1,22 @@+module System.Taffybar.Information.CPUFrequencySpec (spec) where++import System.Taffybar.Information.CPUFrequency+import Test.Hspec++spec :: Spec+spec =+  describe "CPU frequency summaries" $ do+    it "reports average, range, and policy count" $ do+      let info = summarizeCPUFrequencies [1_000_000, 2_000_000, 3_000_000]+      cpuFrequencyAverageKHz info `shouldBe` Just 2_000_000+      cpuFrequencyMinimumKHz info `shouldBe` Just 1_000_000+      cpuFrequencyMaximumKHz info `shouldBe` Just 3_000_000+      cpuFrequencySampleCount info `shouldBe` 3+      cpuFrequencyAverageGHz info `shouldBe` Just 2++    it "represents a missing frequency source without fabricated readings" $ do+      let info = summarizeCPUFrequencies []+      cpuFrequencyAverageKHz info `shouldBe` Nothing+      cpuFrequencyMinimumKHz info `shouldBe` Nothing+      cpuFrequencyMaximumKHz info `shouldBe` Nothing+      cpuFrequencySampleCount info `shouldBe` 0

@@ -2,17 +2,91 @@  module System.Taffybar.Information.NvidiaSpec (spec) where +import Data.Text qualified as T import System.Taffybar.Information.Nvidia import Test.Hspec  spec :: Spec-spec = describe "NVIDIA temperature parsing" $ do-  it "parses and sorts nvidia-smi temperature rows" $-    parseNvidiaGpuTemperatures "2, 73\n0, 56\n"-      `shouldBe` [ NvidiaGpuTemperature 0 56,-                   NvidiaGpuTemperature 2 73-                 ]+spec = do+  describe "NVIDIA information parsing" $ do+    it "parses rich nvidia-smi XML snapshots and optional readings" $ do+      let info = parseNvidiaGpuInfo sampleXml+      map nvidiaInfoIndex info `shouldBe` [0, 2]+      case info of+        firstGpu : _ -> do+          nvidiaInfoName firstGpu `shouldBe` "NVIDIA Test GPU"+          nvidiaInfoTemperatureCelsius firstGpu `shouldBe` Just 61+          nvidiaInfoMemoryTemperatureCelsius firstGpu `shouldBe` Nothing+          nvidiaInfoTargetTemperatureCelsius firstGpu `shouldBe` Just 87+          nvidiaInfoThermalHeadroomCelsius firstGpu `shouldBe` Just 26+          nvidiaInfoGpuUtilizationPercent firstGpu `shouldBe` Just 37+          nvidiaInfoMemoryUsedMiB firstGpu `shouldBe` Just 2048+          nvidiaInfoPowerDrawWatts firstGpu `shouldBe` Just 34.5+          nvidiaInfoPowerLimitWatts firstGpu `shouldBe` Just 80+        [] -> expectationFailure "expected parsed GPU information" -  it "ignores malformed and unavailable rows" $-    parseNvidiaGpuTemperatures "0, N/A\nbad row\n1, 64\n"-      `shouldBe` [NvidiaGpuTemperature 1 64]+    it "rejects malformed XML" $+      parseNvidiaGpuInfo "not xml" `shouldBe` []++  describe "NVIDIA runtime power states" $ do+    it "preserves querying when no NVIDIA PCI devices are detected" $+      shouldQueryNvidiaForRuntimeStatuses [] `shouldBe` True++    it "skips querying when every device is suspended or suspending" $+      shouldQueryNvidiaForRuntimeStatuses+        [Just "suspended", Just "suspending"]+        `shouldBe` False++    it "preserves querying when any device is active" $+      shouldQueryNvidiaForRuntimeStatuses+        [Just "suspended", Just "active"]+        `shouldBe` True++    it "preserves querying when any runtime status is missing" $+      shouldQueryNvidiaForRuntimeStatuses+        [Just "suspended", Nothing]+        `shouldBe` True++    it "preserves querying for unknown runtime states" $+      shouldQueryNvidiaForRuntimeStatuses [Just "unsupported"] `shouldBe` True++  describe "NVIDIA temperature parsing" $ do+    it "parses and sorts nvidia-smi temperature rows" $+      parseNvidiaGpuTemperatures "2, 73\n0, 56\n"+        `shouldBe` [ NvidiaGpuTemperature 0 56,+                     NvidiaGpuTemperature 2 73+                   ]++    it "ignores malformed and unavailable rows" $+      parseNvidiaGpuTemperatures "0, N/A\nbad row\n1, 64\n"+        `shouldBe` [NvidiaGpuTemperature 1 64]++sampleXml :: T.Text+sampleXml =+  T.unlines+    [ "<nvidia_smi_log>",+      "  <gpu>",+      "    <product_name>NVIDIA Second GPU</product_name>",+      "    <minor_number>2</minor_number>",+      "    <temperature><gpu_temp>55 C</gpu_temp></temperature>",+      "  </gpu>",+      "  <gpu>",+      "    <product_name>NVIDIA Test GPU</product_name>",+      "    <minor_number>0</minor_number>",+      "    <fan_speed>N/A</fan_speed>",+      "    <performance_state>P2</performance_state>",+      "    <utilization><gpu_util>37 %</gpu_util><memory_util>3 %</memory_util></utilization>",+      "    <fb_memory_usage><used>2048 MiB</used><total>12282 MiB</total></fb_memory_usage>",+      "    <temperature>",+      "      <gpu_temp>61 C</gpu_temp>",+      "      <gpu_temp_tlimit>26 C</gpu_temp_tlimit>",+      "      <gpu_target_temperature>87 C</gpu_target_temperature>",+      "      <memory_temp>N/A</memory_temp>",+      "    </temperature>",+      "    <gpu_power_readings>",+      "      <average_power_draw>34.50 W</average_power_draw>",+      "      <current_power_limit>80.00 W</current_power_limit>",+      "    </gpu_power_readings>",+      "  </gpu>",+      "</nvidia_smi_log>"+    ]

@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Taffybar.Widget.AnthropicUsageSpec (spec) where++import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import System.Taffybar.Information.AnthropicUsage+import System.Taffybar.Widget.AnthropicUsage+import System.Taffybar.Widget.Util (UsageWindowLabelParts (..), UsageWindowPosition (..))+import Test.Hspec++spec :: Spec+spec =+  describe "Anthropic usage weekly window label" $ do+    it "shows the current day of seven when the OAuth endpoint supplies a reset time" $+      formatAnthropicUsageWindowLabel AnthropicUsageWeeklyWindow AnthropicUsageDisplayRemaining infoWithReset+        `shouldBe` "7d 35%·F35%r 3/7"++    it "uses the ceiling of elapsed 24-hour periods at an exact day boundary" $+      formatAnthropicUsageWindowLabel AnthropicUsageWeeklyWindow AnthropicUsageDisplayRemaining infoAtOneDay+        `shouldBe` "7d 35%r 1/7"++    it "omits the window day for a synthesized transcript fallback window" $+      formatAnthropicUsageWindowLabel AnthropicUsageWeeklyWindow AnthropicUsageDisplayRemaining infoWithoutReset+        `shouldBe` "7d 35%r"++    it "exposes semantic label parts for configurable renderers" $+      anthropicUsageWindowLabelParts AnthropicUsageWeeklyWindow AnthropicUsageDisplayRemaining infoWithReset+        `shouldBe` UsageWindowLabelParts "7d" "35%·F35%r" (Just $ UsageWindowPosition 3 7)++infoWithReset :: AnthropicUsageInfo+infoWithReset =+  (usageInfo generatedAt $ Just resetAt)+    { anthropicUsageScopedWeeklyWindow = Just $ usageWindow "Fable" Nothing+    }++infoAtOneDay :: AnthropicUsageInfo+infoAtOneDay =+  usageInfo+    (read "2026-07-13 12:00:00 UTC")+    (Just resetAt)++infoWithoutReset :: AnthropicUsageInfo+infoWithoutReset = usageInfo generatedAt Nothing++usageInfo :: UTCTime -> Maybe UTCTime -> AnthropicUsageInfo+usageInfo generated reset =+  AnthropicUsageInfo+    { anthropicUsageGeneratedAt = generated,+      anthropicUsageSubscriptionType = Just "max",+      anthropicUsageRateLimitTier = Nothing,+      anthropicUsageHasAvailableSubscription = Just True,+      anthropicUsageExtraUsageDisabledReason = Nothing,+      anthropicUsageOrganizationName = Nothing,+      anthropicUsageFiveHourWindow = usageWindow "5h" Nothing,+      anthropicUsageWeeklyWindow = usageWindow "7d" reset,+      anthropicUsageScopedWeeklyWindow = Nothing+    }++generatedAt :: UTCTime+generatedAt = read "2026-07-15 00:00:00 UTC"++resetAt :: UTCTime+resetAt = read "2026-07-19 12:00:00 UTC"++usageWindow :: Text -> Maybe UTCTime -> AnthropicUsageWindow+usageWindow name resetTime =+  AnthropicUsageWindow+    { anthropicUsageWindowName = name,+      anthropicUsageWindowStart = read "2026-07-12 12:00:00 UTC",+      anthropicUsageWindowEnd = fromMaybe (read "2026-07-19 12:00:00 UTC") resetTime,+      anthropicUsageWindowResetAt = resetTime,+      anthropicUsageWindowBudgetTokens = Nothing,+      anthropicUsageWindowUtilizationPercent = Just 65,+      anthropicUsageWindowTotals = mempty+    }

@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Taffybar.Widget.BatterySpec (spec) where++import DBus (toVariant)+import Data.Map qualified as M+import Data.Word (Word32)+import System.Taffybar.Information.Battery+import System.Taffybar.Widget.Battery+import Test.Hspec++spec :: Spec+spec = do+  describe "formatBatteryInfo" $ do+    it "formats the current energy rate in watts" $ do+      let info =+            infoMapToBatteryInfo $+              M.fromList+                [ ("Percentage", toVariant (96.0 :: Double)),+                  ("EnergyRate", toVariant (19.966 :: Double))+                ]+      formatBatteryInfo info "$percentage$% $watts$W"+        `shouldBe` "96% 20.0W"++    it "uses positive watts for charging and negative watts for discharging" $ do+      let info state rate =+            infoMapToBatteryInfo $+              M.fromList+                [ ("State", toVariant (state :: Word32)),+                  ("EnergyRate", toVariant (rate :: Double))+                ]+      formatBatteryInfo (info 1 19.966) "$signedWatts$W"+        `shouldBe` "+20.0W"+      formatBatteryInfo (info 2 12.34) "$signedWatts$W"+        `shouldBe` "-12.3W"++  describe "defaultMonitorDisplayBatteryProperties" $+    it "refreshes on UPower sampling updates" $+      defaultMonitorDisplayBatteryProperties+        `shouldContain` ["EnergyRate", "UpdateTime"]

@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Taffybar.Widget.OpenAIUsageSpec (spec) where++import System.Taffybar.Information.OpenAIUsage+import System.Taffybar.Widget.OpenAIUsage+import System.Taffybar.Widget.Util (UsageWindowLabelParts (..), UsageWindowPosition (..))+import Test.Hspec++spec :: Spec+spec =+  describe "OpenAI usage window labels" $ do+    it "shows an omitted 5-hour limit as unlimited and keeps the 7-day window in the weekly row" $ do+      formatOpenAIUsageWindowLabel OpenAIUsagePrimaryWindow OpenAIUsageDisplayUsed weeklyOnlyInfo+        `shouldBe` "5h ∞"+      formatOpenAIUsageWindowLabel OpenAIUsageSecondaryWindow OpenAIUsageDisplayUsed weeklyOnlyInfo+        `shouldBe` "7d 17%u"+      formatOpenAIUsageSummaryLabel OpenAIUsageDisplayUsed weeklyOnlyInfo+        `shouldBe` "AI 5h ∞ 7d 17%u"++    it "preserves the normal 5-hour and 7-day layout when both windows are present" $ do+      formatOpenAIUsageWindowLabel OpenAIUsagePrimaryWindow OpenAIUsageDisplayRemaining normalInfo+        `shouldBe` "5h 75%r"+      formatOpenAIUsageWindowLabel OpenAIUsageSecondaryWindow OpenAIUsageDisplayRemaining normalInfo+        `shouldBe` "7d 83%r"++    it "shows the current day of seven when the API supplies an authoritative reset time" $ do+      formatOpenAIUsageWindowLabel OpenAIUsageSecondaryWindow OpenAIUsageDisplayRemaining infoWithReset+        `shouldBe` "83%r 3/7d"+      formatOpenAIUsageSummaryLabel OpenAIUsageDisplayRemaining infoWithReset+        `shouldBe` "AI 5h 75%r 83%r 3/7d"++    it "keeps the window day on the weekly row when the 5-hour limit is omitted" $+      formatOpenAIUsageWindowLabel OpenAIUsageSecondaryWindow OpenAIUsageDisplayUsed weeklyOnlyInfoWithReset+        `shouldBe` "17%u 3/7d"++    it "exposes semantic label parts for configurable renderers" $+      openAIUsageWindowLabelParts OpenAIUsageSecondaryWindow OpenAIUsageDisplayRemaining infoWithReset+        `shouldBe` UsageWindowLabelParts "7d" "83%r" (Just $ UsageWindowPosition 3 7)++weeklyOnlyInfo :: OpenAIUsageInfo+weeklyOnlyInfo = usageInfo weeklyWindow Nothing++normalInfo :: OpenAIUsageInfo+normalInfo = usageInfo fiveHourWindow (Just weeklyWindow)++infoWithReset :: OpenAIUsageInfo+infoWithReset = usageInfo fiveHourWindow (Just weeklyWindowWithReset)++weeklyOnlyInfoWithReset :: OpenAIUsageInfo+weeklyOnlyInfoWithReset = usageInfo weeklyWindowWithReset Nothing++usageInfo :: OpenAIUsageWindow -> Maybe OpenAIUsageWindow -> OpenAIUsageInfo+usageInfo primary secondary =+  OpenAIUsageInfo+    { openAIUsagePlanType = Just "pro",+      openAIUsageRateLimit =+        OpenAIUsageRateLimit+          { openAIUsageAllowed = True,+            openAIUsageLimitReached = False,+            openAIUsagePrimaryWindow = Just primary,+            openAIUsageSecondaryWindow = secondary+          },+      openAIUsageAdditionalRateLimits = [],+      openAIUsageCredits = Nothing,+      openAIUsageReachedType = Nothing+    }++fiveHourWindow :: OpenAIUsageWindow+fiveHourWindow = usageWindow 25 (5 * 60 * 60)++weeklyWindow :: OpenAIUsageWindow+weeklyWindow = usageWindow 17 (7 * 24 * 60 * 60)++weeklyWindowWithReset :: OpenAIUsageWindow+weeklyWindowWithReset =+  weeklyWindow+    { openAIUsageResetAfterSeconds = Just (4 * 24 * 60 * 60),+      openAIUsageResetAt = Just $ read "2026-07-22 12:00:00 UTC"+    }++usageWindow :: Int -> Int -> OpenAIUsageWindow+usageWindow usedPercent duration =+  OpenAIUsageWindow+    { openAIUsageUsedPercent = usedPercent,+      openAIUsageWindowDurationSeconds = Just duration,+      openAIUsageResetAfterSeconds = Just duration,+      openAIUsageResetAt = Nothing,+      openAIUsageWindowTotals = Nothing+    }