packages feed

taffybar 7.2.5 → 7.2.6

raw patch · 9 files changed

+524/−59 lines, 9 filesdep ~gtk-sni-traydep ~status-notifier-itemPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: gtk-sni-tray, status-notifier-item

API changes (from Hackage documentation)

+ System.Taffybar.Information.AnthropicUsage: [anthropicUsageScopedWeeklyWindow] :: AnthropicUsageInfo -> Maybe AnthropicUsageWindow
+ System.Taffybar.Information.AnthropicUsage: instance Data.Aeson.Types.FromJSON.FromJSON System.Taffybar.Information.AnthropicUsage.AnthropicOAuthLimit
+ System.Taffybar.Information.AnthropicUsage: instance GHC.Classes.Eq System.Taffybar.Information.AnthropicUsage.AnthropicOAuthLimit
+ System.Taffybar.Information.AnthropicUsage: instance GHC.Internal.Show.Show System.Taffybar.Information.AnthropicUsage.AnthropicOAuthLimit
+ System.Taffybar.Information.Nvidia: NvidiaGpuTemperature :: Int -> Double -> NvidiaGpuTemperature
+ System.Taffybar.Information.Nvidia: [nvidiaGpuIndex] :: NvidiaGpuTemperature -> Int
+ System.Taffybar.Information.Nvidia: [nvidiaGpuTemperatureCelsius] :: NvidiaGpuTemperature -> Double
+ System.Taffybar.Information.Nvidia: data NvidiaGpuTemperature
+ System.Taffybar.Information.Nvidia: instance GHC.Classes.Eq System.Taffybar.Information.Nvidia.NvidiaGpuTemperature
+ System.Taffybar.Information.Nvidia: instance GHC.Internal.Show.Show System.Taffybar.Information.Nvidia.NvidiaGpuTemperature
+ System.Taffybar.Information.Nvidia: parseNvidiaGpuTemperatures :: Text -> [NvidiaGpuTemperature]
+ System.Taffybar.Information.Nvidia: readNvidiaGpuTemperatures :: IO [NvidiaGpuTemperature]
+ System.Taffybar.Information.Nvidia: readNvidiaGpuTemperaturesWith :: FilePath -> IO [NvidiaGpuTemperature]
+ System.Taffybar.Widget.AnthropicUsage: AnthropicUsageScopedWeeklyWindow :: AnthropicUsageWindowSelector
+ System.Taffybar.Widget.NvidiaTemperature: NvidiaTemperatureConfig :: FilePath -> Maybe Int -> String -> Text -> Double -> Text -> NvidiaTemperatureConfig
+ System.Taffybar.Widget.NvidiaTemperature: [nvidiaTemperatureCommand] :: NvidiaTemperatureConfig -> FilePath
+ System.Taffybar.Widget.NvidiaTemperature: [nvidiaTemperatureFallback] :: NvidiaTemperatureConfig -> Text
+ System.Taffybar.Widget.NvidiaTemperature: [nvidiaTemperatureFormat] :: NvidiaTemperatureConfig -> String
+ System.Taffybar.Widget.NvidiaTemperature: [nvidiaTemperatureGpuIndex] :: NvidiaTemperatureConfig -> Maybe Int
+ System.Taffybar.Widget.NvidiaTemperature: [nvidiaTemperatureIcon] :: NvidiaTemperatureConfig -> Text
+ System.Taffybar.Widget.NvidiaTemperature: [nvidiaTemperaturePollInterval] :: NvidiaTemperatureConfig -> Double
+ System.Taffybar.Widget.NvidiaTemperature: data NvidiaTemperatureConfig
+ System.Taffybar.Widget.NvidiaTemperature: defaultNvidiaTemperatureConfig :: NvidiaTemperatureConfig
+ System.Taffybar.Widget.NvidiaTemperature: instance Data.Default.Internal.Default System.Taffybar.Widget.NvidiaTemperature.NvidiaTemperatureConfig
+ System.Taffybar.Widget.NvidiaTemperature: nvidiaTemperatureIconNew :: MonadIO m => m Widget
+ System.Taffybar.Widget.NvidiaTemperature: nvidiaTemperatureIconNewWith :: MonadIO m => NvidiaTemperatureConfig -> m Widget
+ System.Taffybar.Widget.NvidiaTemperature: nvidiaTemperatureLabelNew :: MonadIO m => m Widget
+ System.Taffybar.Widget.NvidiaTemperature: nvidiaTemperatureLabelNewWith :: MonadIO m => NvidiaTemperatureConfig -> m Widget
+ System.Taffybar.Widget.NvidiaTemperature: nvidiaTemperatureNew :: MonadIO m => m Widget
+ System.Taffybar.Widget.NvidiaTemperature: nvidiaTemperatureNewWith :: MonadIO m => NvidiaTemperatureConfig -> m Widget
- System.Taffybar.Information.AnthropicUsage: AnthropicUsageInfo :: UTCTime -> Maybe Text -> Maybe Text -> Maybe Bool -> Maybe Text -> Maybe Text -> AnthropicUsageWindow -> AnthropicUsageWindow -> AnthropicUsageInfo
+ System.Taffybar.Information.AnthropicUsage: AnthropicUsageInfo :: UTCTime -> Maybe Text -> Maybe Text -> Maybe Bool -> Maybe Text -> Maybe Text -> AnthropicUsageWindow -> AnthropicUsageWindow -> Maybe AnthropicUsageWindow -> AnthropicUsageInfo

Files

CHANGELOG.md view
@@ -1,4 +1,15 @@-# Unreleased+# 7.2.6++## Features++* Add NVIDIA GPU temperature information and a configurable polling widget+  backed by `nvidia-smi`.++## Fixes++* Require `status-notifier-item >= 0.3.2.16` and `gtk-sni-tray >= 0.2.1.4`,+  which collapse duplicate Ayatana tray items even when an application uses a+  freshly generated item identity for every instance.  # 7.2.5 
src/System/Taffybar/Information/AnthropicUsage.hs view
@@ -27,7 +27,7 @@ import Control.Concurrent.MVar import Control.Concurrent.STM (atomically, orElse) import Control.Concurrent.STM.TChan-import Control.Exception (SomeException, try)+import Control.Exception (SomeException, evaluate, try) import Control.Monad (forever, void) import Control.Monad.IO.Class (liftIO) import Data.Aeson@@ -37,6 +37,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.List (sortOn) import qualified Data.List as List+import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import qualified Data.Set as Set import qualified Data.Text as T@@ -46,6 +47,7 @@ import System.Directory   ( doesDirectoryExist,     doesFileExist,+    getFileSize,     getHomeDirectory,     getModificationTime,     listDirectory,@@ -109,7 +111,12 @@     anthropicUsageExtraUsageDisabledReason :: Maybe T.Text,     anthropicUsageOrganizationName :: Maybe T.Text,     anthropicUsageFiveHourWindow :: AnthropicUsageWindow,-    anthropicUsageWeeklyWindow :: AnthropicUsageWindow+    anthropicUsageWeeklyWindow :: AnthropicUsageWindow,+    -- | Weekly limit scoped to a single model (currently \"Fable\"), reported+    -- separately by the OAuth usage endpoint. 'Nothing' when the plan has no+    -- such per-model weekly bucket. The window's name carries the model's+    -- display name so the label reads e.g. @Fable 22%@.+    anthropicUsageScopedWeeklyWindow :: Maybe AnthropicUsageWindow   }   deriving (Eq, Show) @@ -207,9 +214,42 @@       <$> o .:? "utilization"       <*> o .:? "resets_at" +-- | A single entry from the OAuth usage endpoint's @limits@ array. Used to+-- surface the per-model @weekly_scoped@ limit (e.g. Fable), which has no+-- dedicated top-level field.+data AnthropicOAuthLimit = AnthropicOAuthLimit+  { anthropicOAuthLimitKind :: Maybe T.Text,+    anthropicOAuthLimitPercent :: Maybe Double,+    anthropicOAuthLimitResetsAt :: Maybe UTCTime,+    -- | @scope.model.display_name@, when the limit is scoped to a model.+    anthropicOAuthLimitScopeModel :: Maybe T.Text+  }+  deriving (Eq, Show)++instance FromJSON AnthropicOAuthLimit where+  parseJSON = withObject "AnthropicOAuthLimit" $ \o -> do+    scope <- o .:? "scope"+    scopeModel <-+      maybe+        (return Nothing)+        ( withObject "Scope" $ \s -> do+            model <- s .:? "model"+            maybe+              (return Nothing)+              (withObject "Model" (.:? "display_name"))+              model+        )+        scope+    AnthropicOAuthLimit+      <$> o .:? "kind"+      <*> o .:? "percent"+      <*> o .:? "resets_at"+      <*> pure scopeModel+ data AnthropicOAuthUsage = AnthropicOAuthUsage   { anthropicOAuthFiveHour :: Maybe AnthropicOAuthWindow,-    anthropicOAuthSevenDay :: Maybe AnthropicOAuthWindow+    anthropicOAuthSevenDay :: Maybe AnthropicOAuthWindow,+    anthropicOAuthLimits :: [AnthropicOAuthLimit]   }   deriving (Eq, Show) @@ -218,6 +258,7 @@     AnthropicOAuthUsage       <$> o .:? "five_hour"       <*> o .:? "seven_day"+      <*> o .:? "limits" .!= []  -- | Persistent state for OAuth endpoint polling, carried across poll -- iterations so we can space out and back off endpoint requests independently@@ -276,6 +317,23 @@   }   deriving (Eq, Show) +-- | Cached extraction result for a single transcript file, keyed by the+-- file's modification time and size. Only the extracted usage entries are+-- retained, never file contents, so the cache stays small even though the+-- underlying transcripts can be large.+data TranscriptFileCacheEntry = TranscriptFileCacheEntry+  { transcriptCacheModified :: UTCTime,+    transcriptCacheSize :: Integer,+    transcriptCacheEntries :: [TranscriptUsageEntry]+  }++-- | Per-file cache of transcript extractions, carried across poll iterations+-- so unchanged files are not re-read and re-parsed on every poll.+type TranscriptFileCache = Map.Map FilePath TranscriptFileCacheEntry++emptyTranscriptFileCache :: TranscriptFileCache+emptyTranscriptFileCache = Map.empty+ data TranscriptJSON = TranscriptJSON   { transcriptJSONTimestamp :: Maybe UTCTime,     transcriptJSONRequestId :: Maybe T.Text,@@ -319,20 +377,23 @@           anthropicUsageEstimatedCostUSD = Nothing         } --- | One-shot snapshot with no persistent backoff state. Convenience for--- callers and tests; the poll loop uses 'getAnthropicUsageInfoWith' so backoff--- and last-good caching survive across iterations.+-- | One-shot snapshot with no persistent backoff or transcript cache state.+-- Convenience for callers and tests; the poll loop uses+-- 'getAnthropicUsageInfoWith' so backoff, last-good caching, and the per-file+-- transcript cache survive across iterations. getAnthropicUsageInfo :: AnthropicUsageConfig -> IO AnthropicUsageInfo-getAnthropicUsageInfo config =-  newIORef emptyOAuthFetchState >>= getAnthropicUsageInfoWith config+getAnthropicUsageInfo config = do+  oauthStateRef <- newIORef emptyOAuthFetchState+  transcriptCacheRef <- newIORef emptyTranscriptFileCache+  getAnthropicUsageInfoWith config oauthStateRef transcriptCacheRef -getAnthropicUsageInfoWith :: AnthropicUsageConfig -> IORef OAuthFetchState -> IO AnthropicUsageInfo-getAnthropicUsageInfoWith config oauthStateRef = do+getAnthropicUsageInfoWith :: AnthropicUsageConfig -> IORef OAuthFetchState -> IORef TranscriptFileCache -> IO AnthropicUsageInfo+getAnthropicUsageInfoWith config oauthStateRef transcriptCacheRef = do   now <- getCurrentTime   credentials <- decodeFileIfExists =<< maybe defaultClaudeCredentialsPath return (anthropicUsageCredentialsPath config)   metadata <- readAnthropicUsageMetadata config credentials   oauthUsage <- fetchAnthropicOAuthUsageWithBackoff config oauthStateRef now (credentials >>= anthropicCredentialsAccessToken)-  entries <- readAnthropicTranscriptEntries config now+  entries <- readAnthropicTranscriptEntries config transcriptCacheRef now   let fiveHourWindow =         applyOAuthWindow (oauthUsage >>= anthropicOAuthFiveHour) $           buildActiveBlockWindow@@ -349,6 +410,9 @@             (7 * 24 * 60 * 60)             (anthropicUsageWeeklyBudgetTokens config)             entries+      scopedWeeklyWindow =+        buildScopedWeeklyWindow now+          <$> (oauthUsage >>= findScopedWeeklyLimit)   return $     AnthropicUsageInfo       { anthropicUsageGeneratedAt = now,@@ -358,16 +422,19 @@         anthropicUsageExtraUsageDisabledReason = anthropicMetadataExtraUsageDisabledReason metadata,         anthropicUsageOrganizationName = anthropicMetadataOrganizationName metadata,         anthropicUsageFiveHourWindow = fiveHourWindow,-        anthropicUsageWeeklyWindow = weeklyWindow+        anthropicUsageWeeklyWindow = weeklyWindow,+        anthropicUsageScopedWeeklyWindow = scopedWeeklyWindow       }  updateAnthropicUsage :: AnthropicUsageConfig -> IO AnthropicUsageSnapshot-updateAnthropicUsage config =-  newIORef emptyOAuthFetchState >>= updateAnthropicUsageWith config+updateAnthropicUsage config = do+  oauthStateRef <- newIORef emptyOAuthFetchState+  transcriptCacheRef <- newIORef emptyTranscriptFileCache+  updateAnthropicUsageWith config oauthStateRef transcriptCacheRef -updateAnthropicUsageWith :: AnthropicUsageConfig -> IORef OAuthFetchState -> IO AnthropicUsageSnapshot-updateAnthropicUsageWith config oauthStateRef = do-  result <- try $ getAnthropicUsageInfoWith config oauthStateRef+updateAnthropicUsageWith :: AnthropicUsageConfig -> IORef OAuthFetchState -> IORef TranscriptFileCache -> IO AnthropicUsageSnapshot+updateAnthropicUsageWith config oauthStateRef transcriptCacheRef = do+  result <- try $ getAnthropicUsageInfoWith config oauthStateRef transcriptCacheRef   case result of     Right info -> return $ AnthropicUsageAvailable info     Left (err :: SomeException) -> do@@ -502,6 +569,38 @@   seconds <- readMaybe (BS8.unpack raw) :: Maybe Integer   if seconds >= 0 then Just (fromInteger seconds) else Nothing +-- | The first @weekly_scoped@ limit from the endpoint's @limits@ array, i.e.+-- the per-model weekly bucket (currently Fable). Only limits carrying a model+-- scope are considered, so an unscoped @weekly_scoped@ entry is ignored.+findScopedWeeklyLimit :: AnthropicOAuthUsage -> Maybe AnthropicOAuthLimit+findScopedWeeklyLimit usage =+  listToMaybe+    [ 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+-- transcript-derived fallback for these, so the window is populated purely+-- from the endpoint: the model display name becomes the window name and the+-- reported percent becomes the utilization. The start is derived by walking+-- back a week from the reset time so menu durations read sensibly.+buildScopedWeeklyWindow :: UTCTime -> AnthropicOAuthLimit -> AnthropicUsageWindow+buildScopedWeeklyWindow now limit =+  AnthropicUsageWindow+    { anthropicUsageWindowName = fromMaybe "scoped" (anthropicOAuthLimitScopeModel limit),+      anthropicUsageWindowStart =+        maybe now (addUTCTime (negate weekSeconds)) resetsAt,+      anthropicUsageWindowEnd = fromMaybe (addUTCTime weekSeconds now) resetsAt,+      anthropicUsageWindowBudgetTokens = Nothing,+      anthropicUsageWindowUtilizationPercent = anthropicOAuthLimitPercent limit,+      anthropicUsageWindowTotals = mempty+    }+  where+    resetsAt = anthropicOAuthLimitResetsAt limit+    weekSeconds = 7 * 24 * 60 * 60+ applyOAuthWindow :: Maybe AnthropicOAuthWindow -> AnthropicUsageWindow -> AnthropicUsageWindow applyOAuthWindow Nothing window = window applyOAuthWindow (Just oauthWindow) window =@@ -537,17 +636,24 @@   home <- getHomeDirectory   return $ home </> ".claude" </> "projects" -readAnthropicTranscriptEntries :: AnthropicUsageConfig -> UTCTime -> IO [TranscriptUsageEntry]-readAnthropicTranscriptEntries config now = do+readAnthropicTranscriptEntries :: AnthropicUsageConfig -> IORef TranscriptFileCache -> UTCTime -> IO [TranscriptUsageEntry]+readAnthropicTranscriptEntries config transcriptCacheRef now = do   projectsPath <- maybe defaultClaudeProjectsPath return (anthropicUsageProjectsPath config)   exists <- doesDirectoryExist projectsPath   if not exists-    then return []+    then do+      writeIORef transcriptCacheRef emptyTranscriptFileCache+      return []     else do       files <- jsonlFilesModifiedSince (addUTCTime (negate $ anthropicUsageFileLookbackSeconds config) now) projectsPath-      dedupeTranscriptEntries . concat <$> mapM readTranscriptFile files+      cache <- readIORef transcriptCacheRef+      cachedFiles <- mapM (readTranscriptFileCached cache) files+      -- Rebuilding the map from this poll's scan evicts entries for files+      -- that disappeared or aged out of the lookback window.+      writeIORef transcriptCacheRef $ Map.fromList cachedFiles+      return $ dedupeTranscriptEntries $ concatMap (transcriptCacheEntries . snd) cachedFiles -jsonlFilesModifiedSince :: UTCTime -> FilePath -> IO [FilePath]+jsonlFilesModifiedSince :: UTCTime -> FilePath -> IO [(FilePath, UTCTime)] jsonlFilesModifiedSince cutoff path = do   entries <- listDirectory path   concat@@ -562,11 +668,49 @@               if isFile && takeExtension child == ".jsonl"                 then do                   modified <- getModificationTime child-                  return [child | modified >= cutoff]+                  return [(child, modified) | modified >= cutoff]                 else return []       )       entries +-- | Return the cached extraction for a file when its modification time and+-- size are both unchanged, re-reading and re-parsing it otherwise. Freshly+-- parsed entries are forced before caching so no lingering thunks retain the+-- file's parsed contents.+readTranscriptFileCached ::+  TranscriptFileCache ->+  (FilePath, UTCTime) ->+  IO (FilePath, TranscriptFileCacheEntry)+readTranscriptFileCached cache (path, modified) = do+  size <- getFileSize path+  case Map.lookup path cache of+    Just cached+      | transcriptCacheModified cached == modified,+        transcriptCacheSize cached == size ->+          return (path, cached)+    _ -> do+      entries <- readTranscriptFile path+      mapM_ (evaluate . forceUsageEntry) entries+      return (path, TranscriptFileCacheEntry modified size entries)++-- | Fully evaluate an extracted entry so values held in the cache do not+-- retain thunks referencing the transcript file's parsed JSON.+forceUsageEntry :: TranscriptUsageEntry -> ()+forceUsageEntry+  ( TranscriptUsageEntry+      timestamp+      requestId+      (AnthropicUsageTotals requests input cacheCreation cacheRead output cost)+    ) =+    timestamp `seq`+      requestId `seq`+        requests `seq`+          input `seq`+            cacheCreation `seq`+              cacheRead `seq`+                output `seq`+                  maybe () (`seq` ()) cost+ readTranscriptFile :: FilePath -> IO [TranscriptUsageEntry] readTranscriptFile path = do   bytes <- LBS.readFile path@@ -707,7 +851,10 @@   -- Persistent OAuth backoff/last-good state, shared by the initial fetch and   -- every poll iteration so spacing and backoff survive across wakeups.   oauthStateRef <- liftIO $ newIORef emptyOAuthFetchState-  initial <- liftIO $ updateAnthropicUsageWith config oauthStateRef+  -- Per-file transcript extraction cache, shared across poll iterations so+  -- unchanged transcript files are not re-read and re-parsed on every poll.+  transcriptCacheRef <- liftIO $ newIORef emptyTranscriptFileCache+  initial <- liftIO $ updateAnthropicUsageWith config oauthStateRef transcriptCacheRef   var <- liftIO $ newMVar initial   wakeupChan <- getWakeupChannelForDelay (anthropicUsagePollInterval config)   ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan@@ -718,17 +865,18 @@           atomically $             void (readTChan refreshChan)               `orElse` void (readTChan ourWakeupChan)-          refreshAnthropicUsageState config oauthStateRef chan var+          refreshAnthropicUsageState config oauthStateRef transcriptCacheRef chan var   return $ AnthropicUsageChanVar (chan, var, refreshChan)  refreshAnthropicUsageState ::   AnthropicUsageConfig ->   IORef OAuthFetchState ->+  IORef TranscriptFileCache ->   TChan AnthropicUsageSnapshot ->   MVar AnthropicUsageSnapshot ->   IO ()-refreshAnthropicUsageState config oauthStateRef chan var = do-  snapshot <- updateAnthropicUsageWith config oauthStateRef+refreshAnthropicUsageState config oauthStateRef transcriptCacheRef chan var = do+  snapshot <- updateAnthropicUsageWith config oauthStateRef transcriptCacheRef   void $ swapMVar var snapshot   atomically $ writeTChan chan snapshot 
+ src/System/Taffybar/Information/Nvidia.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : System.Taffybar.Information.Nvidia+-- Copyright   : (c) Ivan Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan Malison <IvanMalison@gmail.com>+-- Stability   : unstable+-- Portability : unportable+--+-- NVIDIA GPU information obtained from @nvidia-smi@.+module System.Taffybar.Information.Nvidia+  ( NvidiaGpuTemperature (..),+    parseNvidiaGpuTemperatures,+    readNvidiaGpuTemperatures,+    readNvidiaGpuTemperaturesWith,+  )+where++import Control.Exception (IOException, try)+import Data.List (sortOn)+import Data.Maybe (mapMaybe)+import qualified Data.Text as T+import System.Exit (ExitCode (ExitSuccess))+import System.Process (readProcessWithExitCode)+import Text.Read (readMaybe)++-- | A temperature reported for one NVIDIA GPU.+data NvidiaGpuTemperature = NvidiaGpuTemperature+  { nvidiaGpuIndex :: Int,+    nvidiaGpuTemperatureCelsius :: Double+  }+  deriving (Eq, Show)++-- | Parse @index, temperature.gpu@ rows emitted by @nvidia-smi@.+-- Invalid rows, including unavailable temperature values, are ignored.+parseNvidiaGpuTemperatures :: T.Text -> [NvidiaGpuTemperature]+parseNvidiaGpuTemperatures =+  sortOn nvidiaGpuIndex . mapMaybe parseLine . T.lines+  where+    parseLine line =+      case map T.strip $ T.splitOn "," line of+        [indexText, temperatureText] ->+          NvidiaGpuTemperature+            <$> readMaybe (T.unpack indexText)+            <*> readMaybe (T.unpack temperatureText)+        _ -> Nothing++-- | Read temperatures using @nvidia-smi@ from @PATH@.+-- Returns an empty list when the command is missing or exits unsuccessfully.+readNvidiaGpuTemperatures :: IO [NvidiaGpuTemperature]+readNvidiaGpuTemperatures = readNvidiaGpuTemperaturesWith "nvidia-smi"++-- | Read 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))+  pure $ case result of+    Right (ExitSuccess, output, _) -> parseNvidiaGpuTemperatures $ T.pack output+    _ -> []
src/System/Taffybar/Information/WirePlumber.hs view
@@ -460,6 +460,10 @@         wirePlumberNodeName = nodeName       } +-- | Read the "Props" params of a node as key/value pairs.+--+-- The returned pods are deep copies (see 'spaPodGetPropertyNoFree'), so they+-- stay valid after the params iterators and their pods are garbage collected. readNodeProps :: Node.Node -> IO [(Text, SpaPod.SpaPod)] readNodeProps node = do   maybeParams <- PipewireObject.pipewireObjectEnumParamsSync node "Props" Nothing@@ -467,14 +471,26 @@     Nothing -> pure []     Just params -> do       pods <- catMaybes <$> iteratorValues @(Maybe SpaPod.SpaPod) params-      fmap concat $-        forM pods $ \pod -> do-          iterator <- SpaPod.spaPodNewIterator pod-          props <- catMaybes <$> iteratorValues @(Maybe SpaPod.SpaPod) iterator-          fmap catMaybes $-            forM props $ \propPod -> do-              (ok, key, value) <- spaPodGetPropertyNoFree propPod-              pure $ if ok then Just (key, value) else Nothing+      keyValues <-+        fmap concat $+          forM pods $ \pod -> do+            iterator <- SpaPod.spaPodNewIterator pod+            props <- catMaybes <$> iteratorValues @(Maybe SpaPod.SpaPod) iterator+            propKeyValues <-+              fmap catMaybes $+                forM props $ \propPod -> do+                  (ok, key, value) <- spaPodGetPropertyNoFree propPod+                  pure $ if ok then Just (key, value) else Nothing+            -- The property pods yielded by the iterator wrap data owned by+            -- the parent pod, so keep the parent (and the iterator, which+            -- holds a reference to it) alive until all of them were read.+            mapM_ ManagedPtr.touchManagedPtr props+            ManagedPtr.touchManagedPtr iterator+            ManagedPtr.touchManagedPtr pod+            pure propKeyValues+      mapM_ ManagedPtr.touchManagedPtr pods+      ManagedPtr.touchManagedPtr params+      pure keyValues  spaPodGetPropertyNoFree :: SpaPod.SpaPod -> IO (Bool, Text, SpaPod.SpaPod) spaPodGetPropertyNoFree pod =@@ -488,7 +504,10 @@           if keyPtrValue == nullPtr             then pure ""             else T.pack <$> peekCString keyPtrValue-        value <- ManagedPtr.wrapBoxed SpaPod.SpaPod valuePtrValue+        wrapped <- ManagedPtr.wrapBoxed SpaPod.SpaPod valuePtrValue+        -- wp_spa_pod_get_property returns a wrap pod whose data borrows from+        -- the property pod, so deep copy it before it can outlive its parent.+        value <- SpaPod.spaPodCopy wrapped         pure (result /= 0, key, value)  metadataFindNoFree :: Metadata.Metadata -> Word32 -> Text -> IO (Maybe (Text, Text))@@ -509,12 +528,16 @@             pure $ Just (value, type_)  podArrayChildNumber :: SpaPod.SpaPod -> IO (Maybe Double)-podArrayChildNumber pod =-  do-    isArray <- SpaPod.spaPodIsArray pod+podArrayChildNumber pod = do+  isArray <- SpaPod.spaPodIsArray pod+  result <-     if isArray       then SpaPod.spaPodGetArrayChild pod >>= podNumber       else podNumber pod+  -- wp_spa_pod_get_array_child returns a wrap pod whose data borrows from+  -- the array pod, so keep the array pod alive while the child is read.+  ManagedPtr.touchManagedPtr pod+  pure result  podNumber :: SpaPod.SpaPod -> IO (Maybe Double) podNumber pod = do
src/System/Taffybar/Widget/AnthropicUsage.hs view
@@ -72,6 +72,9 @@ data AnthropicUsageWindowSelector   = AnthropicUsageFiveHourWindow   | AnthropicUsageWeeklyWindow+  | -- | Per-model weekly limit (currently Fable). Absent for plans without one,+    -- in which case the label renders empty.+    AnthropicUsageScopedWeeklyWindow   deriving (Eq, Show)  data AnthropicUsageStackConfig = AnthropicUsageStackConfig@@ -185,10 +188,22 @@     label <- Gtk.labelNew (Just (anthropicUsageLabelFallbackText config))     snapshotVar <- newMVar initialSnapshot     let refreshNow = runReaderT (forceAnthropicUsageRefresh infoConfig) ctx+    -- Visibility is driven by 'updateLabelFromState': a formatter returning+    -- empty text (e.g. the scoped per-model window when the plan has none)+    -- hides the label entirely instead of leaving an empty row, and+    -- no-show-all keeps ancestor 'widgetShowAll' calls from re-showing it.+    Gtk.widgetSetNoShowAll label True     _ <- widgetSetClassGI label (anthropicUsageLabelClass config)     updateLabelFromState config label displayState initialSnapshot      void $ Gtk.onWidgetRealize label $ do+      -- The usage listener only runs while the label is realized (e.g. the+      -- visible page of a GtkStack), so broadcasts that arrived while the+      -- widget was hidden were missed. Re-sync from the shared state before+      -- listening so the label does not show a stale snapshot.+      currentSnapshot <- runReaderT (getAnthropicUsageState infoConfig) ctx+      void $ swapMVar snapshotVar currentSnapshot+      updateLabelFromState config label displayState currentSnapshot       usageThread <- forkUsageListener config label displayState snapshotVar usageChan       modeThread <- forkDisplayModeListener config label displayState snapshotVar       void $ Gtk.onWidgetUnrealize label $ do@@ -280,6 +295,7 @@   postGUIASync $ do     Gtk.labelSetText label labelText     Gtk.widgetSetTooltipText label tooltipText+    Gtk.widgetSetVisible label (not (T.null labelText))  formatSnapshotLabel :: AnthropicUsageLabelConfig -> AnthropicUsageDisplayMode -> AnthropicUsageSnapshot -> T.Text formatSnapshotLabel config mode snapshot =@@ -305,15 +321,32 @@         T.intercalate           " "           [ formatWindowLabel displayMode (anthropicUsageFiveHourWindow info),-            formatWindowLabel displayMode (anthropicUsageWeeklyWindow info)+            formatWeeklyWithScopedLabel displayMode info           ]       unavailable = anthropicUsageHasAvailableSubscription info == Just False    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 =-  formatWindowLabel displayMode (selectedWindow selector info)+  maybe "" (formatWindowLabel displayMode) (selectedWindow selector info) +-- | 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.+formatWeeklyWithScopedLabel :: AnthropicUsageDisplayMode -> AnthropicUsageInfo -> T.Text+formatWeeklyWithScopedLabel displayMode info =+  let weekly = anthropicUsageWeeklyWindow info+      scopedPart window =+        "·"+          <> T.toUpper (T.take 1 (anthropicUsageWindowName window))+          <> formatWindowValue displayMode window+   in anthropicUsageWindowName weekly+        <> " "+        <> formatWindowValue displayMode weekly+        <> maybe "" scopedPart (anthropicUsageScopedWeeklyWindow info)+        <> displayModeIndicator displayMode+ formatAnthropicUsageTooltip :: AnthropicUsageDisplayMode -> AnthropicUsageSnapshot -> Maybe T.Text formatAnthropicUsageTooltip displayMode snapshot =   Just $@@ -328,6 +361,12 @@               Just $ "Display: " <> displayModeText displayMode,               Just $ "5h: " <> formatWindow displayMode (anthropicUsageGeneratedAt info) (anthropicUsageFiveHourWindow info),               Just $ "7d: " <> formatWindow displayMode (anthropicUsageGeneratedAt info) (anthropicUsageWeeklyWindow info),+              ( \window ->+                  anthropicUsageWindowName window+                    <> ": "+                    <> formatWindow displayMode (anthropicUsageGeneratedAt info) window+              )+                <$> anthropicUsageScopedWeeklyWindow info,               formatSubscriptionStatus info,               ("Extra usage disabled: " <>) <$> anthropicUsageExtraUsageDisabledReason info             ]@@ -438,6 +477,11 @@     menu     "7d Window"     (formatWindowMenuLines displayMode (anthropicUsageGeneratedAt info) (anthropicUsageWeeklyWindow info))+  forM_ (anthropicUsageScopedWeeklyWindow info) $ \window ->+    appendMenuSection+      menu+      (anthropicUsageWindowName window <> " Window")+      (formatWindowMenuLines displayMode (anthropicUsageGeneratedAt info) window)   appendMenuSection     menu     "Extra Usage"@@ -551,9 +595,10 @@ displayModeIndicator AnthropicUsageDisplayUsed = "u" displayModeIndicator AnthropicUsageDisplayRemaining = "r" -selectedWindow :: AnthropicUsageWindowSelector -> AnthropicUsageInfo -> AnthropicUsageWindow-selectedWindow AnthropicUsageFiveHourWindow = anthropicUsageFiveHourWindow-selectedWindow AnthropicUsageWeeklyWindow = anthropicUsageWeeklyWindow+selectedWindow :: AnthropicUsageWindowSelector -> AnthropicUsageInfo -> Maybe AnthropicUsageWindow+selectedWindow AnthropicUsageFiveHourWindow = Just . anthropicUsageFiveHourWindow+selectedWindow AnthropicUsageWeeklyWindow = Just . anthropicUsageWeeklyWindow+selectedWindow AnthropicUsageScopedWeeklyWindow = anthropicUsageScopedWeeklyWindow  formatDuration :: Int -> T.Text formatDuration seconds
+ src/System/Taffybar/Widget/NvidiaTemperature.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : System.Taffybar.Widget.NvidiaTemperature+-- Copyright   : (c) Ivan Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan Malison <IvanMalison@gmail.com>+-- Stability   : unstable+-- Portability : unportable+--+-- A widget for displaying NVIDIA GPU temperatures from @nvidia-smi@.+module System.Taffybar.Widget.NvidiaTemperature+  ( -- * Combined icon+label widget+    nvidiaTemperatureNew,+    nvidiaTemperatureNewWith,++    -- * Icon-only widget+    nvidiaTemperatureIconNew,+    nvidiaTemperatureIconNewWith,++    -- * Label-only widget+    nvidiaTemperatureLabelNew,+    nvidiaTemperatureLabelNewWith,++    -- * Configuration+    NvidiaTemperatureConfig (..),+    defaultNvidiaTemperatureConfig,+  )+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Default (Default (..))+import Data.List (find, intercalate, maximumBy)+import Data.Ord (comparing)+import qualified Data.Text as T+import qualified GI.Gtk as Gtk+import System.Taffybar.Information.Nvidia+import System.Taffybar.Widget.Generic.PollingLabel (pollingLabelNewWithTooltip)+import System.Taffybar.Widget.Util (buildIconLabelBox, widgetSetClassGI)+import qualified Text.StringTemplate as ST++-- | Configuration for the NVIDIA temperature widget.+data NvidiaTemperatureConfig = NvidiaTemperatureConfig+  { -- | Path or command name for @nvidia-smi@.+    nvidiaTemperatureCommand :: FilePath,+    -- | GPU index to display. 'Nothing' displays the hottest available GPU.+    nvidiaTemperatureGpuIndex :: Maybe Int,+    -- | Label template. Available variables are @gpu@ and @tempC@.+    nvidiaTemperatureFormat :: String,+    -- | Text displayed when no temperature is available.+    nvidiaTemperatureFallback :: T.Text,+    -- | Polling period in seconds.+    nvidiaTemperaturePollInterval :: Double,+    -- | Icon used by the combined icon and label widget.+    nvidiaTemperatureIcon :: T.Text+  }++instance Default NvidiaTemperatureConfig where+  def = defaultNvidiaTemperatureConfig++-- | Default to GPU 0, refreshed every ten seconds.+defaultNvidiaTemperatureConfig :: NvidiaTemperatureConfig+defaultNvidiaTemperatureConfig =+  NvidiaTemperatureConfig+    { nvidiaTemperatureCommand = "nvidia-smi",+      nvidiaTemperatureGpuIndex = Just 0,+      nvidiaTemperatureFormat = "GPU $tempC$\176C",+      nvidiaTemperatureFallback = "GPU N/A",+      nvidiaTemperaturePollInterval = 10,+      nvidiaTemperatureIcon = "\xF2C9"+    }++-- | Create a combined icon and label widget with the default configuration.+nvidiaTemperatureNew :: (MonadIO m) => m Gtk.Widget+nvidiaTemperatureNew = nvidiaTemperatureNewWith defaultNvidiaTemperatureConfig++-- | Create a combined icon and label widget.+nvidiaTemperatureNewWith :: (MonadIO m) => NvidiaTemperatureConfig -> m Gtk.Widget+nvidiaTemperatureNewWith config = liftIO $ do+  iconWidget <- nvidiaTemperatureIconNewWith config+  labelWidget <- nvidiaTemperatureLabelNewWith config+  buildIconLabelBox iconWidget labelWidget+    >>= (`widgetSetClassGI` "nvidia-temperature")++-- | Create an icon widget with the default configuration.+nvidiaTemperatureIconNew :: (MonadIO m) => m Gtk.Widget+nvidiaTemperatureIconNew = nvidiaTemperatureIconNewWith defaultNvidiaTemperatureConfig++-- | Create an icon widget with the provided configuration.+nvidiaTemperatureIconNewWith :: (MonadIO m) => NvidiaTemperatureConfig -> m Gtk.Widget+nvidiaTemperatureIconNewWith config = liftIO $ do+  label <- Gtk.labelNew $ Just $ nvidiaTemperatureIcon config+  _ <- widgetSetClassGI label "nvidia-temperature-icon"+  Gtk.widgetShowAll label+  Gtk.toWidget label++-- | Create a label widget with the default configuration.+nvidiaTemperatureLabelNew :: (MonadIO m) => m Gtk.Widget+nvidiaTemperatureLabelNew = nvidiaTemperatureLabelNewWith defaultNvidiaTemperatureConfig++-- | Create a label widget that polls @nvidia-smi@.+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)+  widgetSetClassGI widget "nvidia-temperature-label"++selectTemperature :: NvidiaTemperatureConfig -> [NvidiaGpuTemperature] -> Maybe NvidiaGpuTemperature+selectTemperature _ [] = Nothing+selectTemperature config temperatures =+  case nvidiaTemperatureGpuIndex config of+    Just index -> find ((== index) . nvidiaGpuIndex) temperatures+    Nothing -> Just $ maximumBy (comparing nvidiaGpuTemperatureCelsius) temperatures++formatLabel :: NvidiaTemperatureConfig -> NvidiaGpuTemperature -> T.Text+formatLabel config temperature =+  T.pack $ ST.render template+  where+    template =+      ST.setManyAttrib+        [ ("gpu", show $ nvidiaGpuIndex temperature),+          ("tempC", show (round (nvidiaGpuTemperatureCelsius temperature) :: Int))+        ]+        $ ST.newSTMP+        $ nvidiaTemperatureFormat config++formatTooltip :: [NvidiaGpuTemperature] -> Maybe T.Text+formatTooltip [] = Nothing+formatTooltip temperatures =+  Just $ T.pack $ intercalate "\n" $ map formatOne temperatures+  where+    formatOne temperature =+      "NVIDIA GPU "+        ++ show (nvidiaGpuIndex temperature)+        ++ ": "+        ++ show (round (nvidiaGpuTemperatureCelsius temperature) :: Int)+        ++ "\176C"
src/System/Taffybar/Widget/OpenAIUsage.hs view
@@ -25,7 +25,7 @@  import Control.Concurrent (ThreadId, forkIO, killThread) import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)-import Control.Concurrent.STM (atomically, newTVarIO, readTVarIO, writeTVar)+import Control.Concurrent.STM (atomically, newTVarIO, readTVarIO, swapTVar) import Control.Concurrent.STM.TChan (TChan, dupTChan, newBroadcastTChanIO, readTChan, writeTChan) import Control.Monad (forM_, forever, void) import Control.Monad.IO.Class (liftIO)@@ -228,16 +228,21 @@       initialSnapshot   menuVar <- newTVarIO menu -  let rebuildMenu snapshot =-        buildUsageMenu-          ebox-          config-          (openAIUsageLabel parts)-          (openAIUsageLabelDisplayState parts)-          (openAIUsageLabelSnapshotVar parts)-          (openAIUsageLabelRefreshNow parts)-          snapshot-          >>= atomically . writeTVar menuVar+  let rebuildMenu snapshot = do+        newMenu <-+          buildUsageMenu+            ebox+            config+            (openAIUsageLabel parts)+            (openAIUsageLabelDisplayState parts)+            (openAIUsageLabelSnapshotVar parts)+            (openAIUsageLabelRefreshNow parts)+            snapshot+        oldMenu <- atomically $ swapTVar menuVar newMenu+        -- Attached menus hold a GObject reference, so the replaced menu+        -- must be destroyed explicitly or it (and its item tree) leaks on+        -- every usage snapshot.+        Gtk.widgetDestroy oldMenu    void $ Gtk.onWidgetRealize ebox $ do     menuThread <-
taffybar.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: taffybar-version: 7.2.5+version: 7.2.6 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.@@ -96,7 +96,7 @@                , gi-gtk-hs >= 0.3.17 && < 0.4                , gi-pango >= 1.0 && < 1.1                , gtk-scaling-image >= 0.1.0.1 && < 0.2-               , gtk-sni-tray >= 0.2.1.3 && < 0.3+               , gtk-sni-tray >= 0.2.1.4 && < 0.3                , gtk-strut >= 0.1.4.1 && < 0.2                , haskell-gi-base >= 0.24 && < 0.27                , hslogger >= 1.2 && < 1.4@@ -112,7 +112,7 @@                , regex-compat >= 0.95 && < 0.96                , safe >= 0.3 && < 1                , split >= 0.1.4.2 && < 0.3-               , status-notifier-item >= 0.3.2.15 && < 0.4+               , status-notifier-item >= 0.3.2.16 && < 0.4                , stm >= 2.5 && < 2.6                , template-haskell >= 2.17 && < 2.24                , text >= 1.2 && < 2.2@@ -165,6 +165,7 @@                  , System.Taffybar.Information.MPRIS2                  , System.Taffybar.Information.Memory                  , System.Taffybar.Information.Network+                 , System.Taffybar.Information.Nvidia                  , System.Taffybar.Information.Temperature                  , System.Taffybar.Information.NetworkManager                  , System.Taffybar.Information.OpenAIUsage@@ -225,6 +226,7 @@                  , System.Taffybar.Widget.MPRIS2                  , System.Taffybar.Widget.NetworkGraph                  , System.Taffybar.Widget.NetworkManager+                 , System.Taffybar.Widget.NvidiaTemperature                  , System.Taffybar.Widget.OmniMenu                  , System.Taffybar.Widget.OpenAIUsage                  , System.Taffybar.Widget.PowerProfiles@@ -397,6 +399,7 @@                , System.Taffybar.ContextSpec                , System.Taffybar.Information.CryptoSpec                , System.Taffybar.Information.LayoutSpec+               , System.Taffybar.Information.NvidiaSpec                , System.Taffybar.Information.Workspaces.EWMHSpec                , System.Taffybar.Information.Workspaces.HyprlandSpec                , System.Taffybar.Information.X11DesktopInfoSpec
+ test/unit/System/Taffybar/Information/NvidiaSpec.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Taffybar.Information.NvidiaSpec (spec) where++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+                 ]++  it "ignores malformed and unavailable rows" $+    parseNvidiaGpuTemperatures "0, N/A\nbad row\n1, 64\n"+      `shouldBe` [NvidiaGpuTemperature 1 64]