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 +12/−1
- src/System/Taffybar/Information/AnthropicUsage.hs +175/−27
- src/System/Taffybar/Information/Nvidia.hs +70/−0
- src/System/Taffybar/Information/WirePlumber.hs +35/−12
- src/System/Taffybar/Widget/AnthropicUsage.hs +50/−5
- src/System/Taffybar/Widget/NvidiaTemperature.hs +142/−0
- src/System/Taffybar/Widget/OpenAIUsage.hs +16/−11
- taffybar.cabal +6/−3
- test/unit/System/Taffybar/Information/NvidiaSpec.hs +18/−0
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]