taffybar 7.0.1 → 7.1.0

raw patch · 13 files changed

+1971/−50 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−1
• src/System/Taffybar.hs +34/−7
• src/System/Taffybar/Context.hs +78/−13
• src/System/Taffybar/Context/Backend.hs +90/−22
• src/System/Taffybar/Information/AnthropicUsage.hs +506/−0
• src/System/Taffybar/Information/Layout/Hyprland.hs +1/−2
• src/System/Taffybar/Information/OpenAIUsage.hs +252/−0
• src/System/Taffybar/Widget/AnthropicUsage.hs +476/−0
• src/System/Taffybar/Widget/OpenAIUsage.hs +483/−0
• src/System/Taffybar/Widget/Workspaces.hs +1/−1
• taffybar.cabal +6/−1
• test/unit/System/Taffybar/ContextSpec.hs +31/−2
• test/unit/System/Taffybar/Information/Workspaces/EWMHSpec.hs +0/−1

@@ -1,4 +1,16 @@-# Unreleased+# 7.1.0++## New Features++* Add structured OpenAI usage information and an OpenAI usage widget.+* Add Anthropic usage information and an Anthropic usage widget.++## Fixes++* Refresh window state after Hyprland reconnects.+* Fix backend detection and X11 strut sizing.+* Handle non-X11 GDK windows safely.+* Stabilize CSS loading for themed end widgets.  ## Refactors 

@@ -133,6 +133,7 @@ import qualified Control.Concurrent.MVar as MV import Control.Exception (finally) import Control.Monad+import Data.Char (toLower) import Data.Function (on) import qualified Data.GI.Gtk.Threading as GIThreading import Data.List (groupBy, isPrefixOf, sort)@@ -144,13 +145,15 @@ import Graphics.X11.Xlib.Misc (initThreads) import Paths_taffybar (getDataDir) import System.Directory+import System.Environment (lookupEnv) import System.Environment.XDG.BaseDir (getUserConfigFile) import System.Exit (exitFailure) import System.FSNotify (Event (..), EventIsDirectory (..), startManager, stopManager, watchDir)-import System.FilePath (normalise, takeDirectory, takeFileName, (</>))+import System.FilePath (normalise, splitSearchPath, takeDirectory, takeFileName, (</>)) import qualified System.IO as IO import System.Log.Logger import System.Taffybar.Context+import System.Taffybar.Context.Backend (prepareBackendEnvironment) import System.Taffybar.Hooks import System.Taffybar.Util (maybeHandleSigHUP, onSigINT, rebracket_) @@ -192,14 +195,37 @@  -- | Return CSS files which should be loaded for the given config. getCSSPaths :: TaffybarConfig -> IO [FilePath]-getCSSPaths TaffybarConfig {cssPaths} = sequence (defaultCSS : userCSS)+getCSSPaths TaffybarConfig {cssPaths} = do+  disableVendor <- envFlag "TAFFYBAR_DISABLE_VENDOR_CSS"+  disableUser <- envFlag "TAFFYBAR_DISABLE_USER_CSS"+  explicitUserCss <- lookupEnv "TAFFYBAR_CSS_PATHS"+  resolvedUserCss <-+    if disableUser+      then pure []+      else case explicitUserCss of+        Just rawPaths -> pure $ filter (not . null) (splitSearchPath rawPaths)+        Nothing -> sequence defaultUserCSS+  vendorCss <-+    if disableVendor+      then pure []+      else (: []) <$> defaultCSS+  pure (vendorCss <> resolvedUserCss)   where     -- Vendor CSS file, which is always loaded before user's CSS.     defaultCSS = getDataFile "taffybar.css"     -- User's configured CSS files, with XDG config file being the default.-    userCSS+    defaultUserCSS       | null cssPaths = [getTaffyFile "taffybar.css"]       | otherwise = map return cssPaths+    envFlag name = do+      value <- lookupEnv name+      pure $+        case fmap (map toLower) value of+          Just "1" -> True+          Just "true" -> True+          Just "yes" -> True+          Just "on" -> True+          _ -> False  -- | Overrides the default GTK theme and settings with CSS styles from -- the given files (if they exist).@@ -315,13 +341,14 @@   setTaffyLogFormatter "System.Taffybar"   setTaffyLogFormatter "StatusNotifier" -  -- Detect backend once up-front so any environment fixups happen before GTK-  -- initialization, and so we don't have multiple ad-hoc checks spread around.-  backendType <- detectBackend-  when (backendType == BackendX11) $ void initThreads+  -- Fix up stale session-manager environment before GTK/GDK choose a display,+  -- then use GDK's actual opened display as the source of truth.+  prepareBackendEnvironment+  void initThreads    _ <- Gtk.init Nothing   GIThreading.setCurrentThreadAsGUIThread+  backendType <- detectBackend    cssPathsToLoad <- getCSSPaths config   context <- buildContextWithBackend backendType config

@@ -76,11 +76,12 @@ import Control.Arrow ((&&&), (***)) import Control.Concurrent (forkIO, threadDelay) import qualified Control.Concurrent.MVar as MV-import Control.Concurrent.STM.TChan (TChan)+import Control.Concurrent.STM.TChan (TChan, readTChan) import Control.Exception (SomeException, try) import Control.Exception.Enclosed (catchAny) import Control.Monad import Control.Monad.IO.Class+import Control.Monad.STM (atomically) import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Control.Monad.Trans.Reader@@ -88,11 +89,12 @@ import qualified DBus.Client as DBus import Data.Data import Data.Default (Default (..))-import Data.GI.Base.ManagedPtr (unsafeCastTo)+import Data.GI.Base (castTo) import Data.IORef import Data.Int import Data.List import qualified Data.Map as M+import Data.Maybe (isNothing) import qualified Data.Text as T import Data.Tuple.Select import Data.Tuple.Sequence@@ -363,6 +365,9 @@       startup       logC DEBUG "Queing build windows command"       refreshTaffyWindows+      when (backendType == BackendWayland) $+        liftIO $+          registerHyprlandReconnectRefresh context     logIO DEBUG "Context build finished"     return context @@ -411,6 +416,49 @@           ++ show e     Right _ -> pure () +-- | Recreate Wayland bar windows when the Hyprland event socket reconnects.+--+-- Hyprland restarts can leave existing layer-shell surfaces invisible even+-- though the taffybar process and widget state loops are still alive. The+-- Hyprland event reader emits @taffybar-hyprland-connected@ after every event+-- socket connection, so use reconnects as the compositor-lifecycle signal and+-- force a top-level window refresh.+registerHyprlandReconnectRefresh :: Context -> IO ()+registerHyprlandReconnectRefresh ctx = do+  eventChan <- withHyprlandEventChan ctx+  events <- subscribeHyprlandEvents eventChan+  readyVar <- MV.newMVar False+  pendingVar <- MV.newMVar False+  void $ forkIO $ do+    -- The event reader also emits a connection event during normal startup.+    -- Ignore early connection events so startup does not immediately rebuild+    -- the windows it just created.+    threadDelay 2_000_000+    void $ MV.swapMVar readyVar True++  let isConnectedEvent line =+        T.takeWhile (/= '>') line == "taffybar-hyprland-connected"++      scheduleRefresh = do+        wasPending <- MV.swapMVar pendingVar True+        unless wasPending $ void $ forkIO $ do+          -- Give Hyprland/GDK a short settling window before rebuilding+          -- layer-shell surfaces.+          threadDelay 1_000_000+          _ <- MV.swapMVar pendingVar False+          logIO NOTICE "Hyprland event socket reconnected - forcing taffybar window refresh"+          postGUIASync $ runReaderT forceRefreshTaffyWindows ctx++      handleConnectedEvent = do+        ready <- MV.readMVar readyVar+        if ready+          then scheduleRefresh+          else logIO DEBUG "Ignoring Hyprland event socket connection during startup"++  void $ forkIO $ forever $ do+    line <- atomically $ readTChan events+    when (isConnectedEvent line) handleConnectedEvent+ -- | Build an empty taffybar context. This function is mostly useful for -- invoking functions that yield 'TaffyIO' values in a testing setting (e.g. in -- a repl).@@ -558,14 +606,21 @@          Gtk.containerAdd window box -        let addToStart count widget = do-              _ <- widgetSetClassGI widget $ T.pack $ printf "left-%d" (count :: Int)+        let addIndexedClass :: (Gtk.IsWidget b, MonadIO m) => T.Text -> Int -> b -> m b+            addIndexedClass prefix count widget =+              widgetSetClassGI widget $ T.pack $ printf "%s-%d" (T.unpack prefix) count+            addEndPaletteClasses count widget = do+              let _ = count+              widgetSetClassGI widget "end-widget"+            addToStart count widget = do+              _ <- addIndexedClass "left" count widget               Gtk.boxPackStart box widget False False 0             addToEnd count widget = do-              _ <- widgetSetClassGI widget $ T.pack $ printf "right-%d" (count :: Int)+              _ <- addIndexedClass "right" count widget+              _ <- addEndPaletteClasses count widget               Gtk.boxPackEnd box widget False False 0             addToCenter count widget = do-              _ <- widgetSetClassGI widget $ T.pack $ printf "center-%d" (count :: Int)+              _ <- addIndexedClass "center" count widget               Gtk.boxPackStart centerBox widget False False 0          logIO DEBUG "Building start widgets"@@ -607,14 +662,21 @@                Gtk.boxPackStart levelsBox box False True 0 -              let addToStart count widget = do-                    _ <- widgetSetClassGI widget $ T.pack $ printf "left-%d" (count :: Int)+              let addIndexedClass :: (Gtk.IsWidget b, MonadIO m) => T.Text -> Int -> b -> m b+                  addIndexedClass prefix count widget =+                    widgetSetClassGI widget $ T.pack $ printf "%s-%d" (T.unpack prefix) count+                  addEndPaletteClasses count widget = do+                    let _ = count+                    widgetSetClassGI widget "end-widget"+                  addToStart count widget = do+                    _ <- addIndexedClass "left" count widget                     Gtk.boxPackStart box widget False False 0                   addToEnd count widget = do-                    _ <- widgetSetClassGI widget $ T.pack $ printf "right-%d" (count :: Int)+                    _ <- addIndexedClass "right" count widget+                    _ <- addEndPaletteClasses count widget                     Gtk.boxPackEnd box widget False False 0                   addToCenter count widget = do-                    _ <- widgetSetClassGI widget $ T.pack $ printf "center-%d" (count :: Int)+                    _ <- addIndexedClass "center" count widget                     Gtk.boxPackStart centerBox widget False False 0                logIO DEBUG $ printf "Building level %d start widgets" (levelCount :: Int)@@ -636,13 +698,16 @@   mapM_ Gtk.widgetShow shownBoxes    when (backend context == BackendX11) $-    runX11Context context () $-      void $+    runX11Context context () $ do+      lowered <-         runMaybeT $ do           gdkWindow <- MaybeT $ Gtk.widgetGetWindow window-          xid <- GdkX11.x11WindowGetXid =<< liftIO (unsafeCastTo X11Window gdkWindow)+          x11Window <- MaybeT $ liftIO (castTo X11Window gdkWindow)+          xid <- liftIO $ GdkX11.x11WindowGetXid x11Window           logC DEBUG $ printf "Lowering X11 window %s" $ show xid           lift $ doLowerWindow (fromIntegral xid)+      when (isNothing lowered) $+        logC WARNING "Skipping X11 lower-window step because the realized GTK window was not an X11Window"    return window 

@@ -20,6 +20,8 @@ module System.Taffybar.Context.Backend   ( Backend (..),     detectBackend,+    detectBackendFromGdk,+    prepareBackendEnvironment,      -- * Discovery helpers     discoverWaylandSocket,@@ -29,7 +31,12 @@  import Control.Exception.Enclosed (catchAny) import Control.Monad+import Data.GI.Base (castTo) import Data.List (isPrefixOf, isSuffixOf)+import Data.Maybe (isJust)+import qualified Data.Text as T+import qualified GI.Gdk as Gdk+import qualified GI.GdkX11.Objects.X11Display as GdkX11 import System.Directory (doesPathExist, listDirectory) import System.Environment (lookupEnv, setEnv, unsetEnv) import System.FilePath ((</>))@@ -65,16 +72,15 @@   where     go [] = pure Nothing     go (c : cs) = do-      ok <--        catchAny-          (isSocket <$> getFileStatus (runtime </> c))-          (const $ pure False)+      ok <- isSocketPath (runtime </> c)       if ok then pure (Just c) else go cs  -- | Try to find a Hyprland instance signature in @XDG_RUNTIME_DIR/hypr/@. -- -- Hyprland creates a directory named after its instance signature under--- @$XDG_RUNTIME_DIR/hypr/@ containing @hyprland.lock@.+-- @$XDG_RUNTIME_DIR/hypr/@ containing live command/event sockets. Stale+-- instance directories can remain after a compositor exits, so lock files are+-- not sufficient evidence that Hyprland is the active session. discoverHyprlandSignature :: FilePath -> IO (Maybe String) discoverHyprlandSignature runtime = do   let hyprDir = runtime </> "hypr"@@ -87,9 +93,24 @@   where     go _ [] = pure Nothing     go hyprDir (e : es) = do-      isSig <- doesPathExist (hyprDir </> e </> "hyprland.lock")+      isSig <- isLiveHyprlandSignature (hyprDir </> e)       if isSig then pure (Just e) else go hyprDir es +isSocketPath :: FilePath -> IO Bool+isSocketPath path =+  catchAny+    (isSocket <$> getFileStatus path)+    (const $ pure False)++isLiveHyprlandSignature :: FilePath -> IO Bool+isLiveHyprlandSignature dir =+  (||)+    <$> isSocketPath (dir </> ".socket.sock")+    <*> isSocketPath (dir </> ".socket2.sock")++envIsNonEmpty :: Maybe String -> Bool+envIsNonEmpty = maybe False (not . null)+ -- | Detect the display-server backend, compensating for stale or missing -- environment variables. --@@ -104,19 +125,32 @@ --   or empty even though a Wayland compositor is running (e.g. after switching --   from an X11 session). ----- This function discovers the real state by probing @XDG_RUNTIME_DIR@, fixes--- up the process environment so downstream code sees consistent values, and--- returns the appropriate 'Backend'.-detectBackend :: IO Backend-detectBackend = do+-- This function probes @XDG_RUNTIME_DIR@ only when the current process+-- environment does not already identify an active X11 session, then fixes up+-- the process environment so GDK sees consistent display variables.+prepareBackendEnvironment :: IO ()+prepareBackendEnvironment = do   mRuntime <- lookupEnv "XDG_RUNTIME_DIR"   mDisplay <- lookupEnv "DISPLAY"   mSessionType <- lookupEnv "XDG_SESSION_TYPE"+  rawWaylandDisplay <- lookupEnv "WAYLAND_DISPLAY" +  let hasDisplay = envIsNonEmpty mDisplay+      explicitX11Session = mSessionType == Just "x11" && hasDisplay++  -- If the process environment identifies the active session as X11, trust it+  -- over ambient Wayland sockets in XDG_RUNTIME_DIR. Those sockets can outlive+  -- or coexist with a different login session and are not sufficient evidence+  -- that this process should initialize GTK as Wayland.+  when explicitX11Session $ do+    unsetEnv "WAYLAND_DISPLAY"+    unsetEnv "HYPRLAND_INSTANCE_SIGNATURE"+    logIO DEBUG "X11 session detected; ignoring ambient Wayland sockets"+   -- Discover and fix up WAYLAND_DISPLAY if it is missing or empty.-  mWaylandDisplay <- do-    raw <- lookupEnv "WAYLAND_DISPLAY"-    case (mRuntime, raw) of+  void $ do+    case (mRuntime, rawWaylandDisplay) of+      _ | explicitX11Session -> pure Nothing       (Just runtime, val) | maybe True null val -> do         mSock <- discoverWaylandSocket runtime         case mSock of@@ -124,11 +158,11 @@             logIO INFO $ "Discovered wayland socket: " ++ sock             setEnv "WAYLAND_DISPLAY" sock             pure (Just sock)-          Nothing -> pure raw-      _ -> pure raw+          Nothing -> pure rawWaylandDisplay+      _ -> pure rawWaylandDisplay    -- Discover and fix up HYPRLAND_INSTANCE_SIGNATURE if it is missing or empty.-  do+  unless explicitX11Session $ do     raw <- lookupEnv "HYPRLAND_INSTANCE_SIGNATURE"     case (mRuntime, raw) of       (Just runtime, val) | maybe True null val -> do@@ -140,6 +174,37 @@           Nothing -> pure ()       _ -> pure () +-- | Detect the backend from the display that GDK actually opened.+--+-- This should be preferred after @Gtk.init@. Before GTK/GDK initialization,+-- 'Gdk.displayGetDefault' usually returns 'Nothing', so callers still need+-- 'prepareBackendEnvironment' to steer GDK toward the intended display.+detectBackendFromGdk :: IO (Maybe Backend)+detectBackendFromGdk = do+  mDisplay <- Gdk.displayGetDefault+  case mDisplay of+    Nothing -> pure Nothing+    Just display -> do+      displayName <- Gdk.displayGetName display+      isX11 <- isJust <$> castTo GdkX11.X11Display display+      let selected =+            if isX11+              then BackendX11+              else BackendWayland+      logIO INFO $+        "Detected backend from GDK display "+          ++ T.unpack displayName+          ++ ": "+          ++ show selected+      pure $ Just selected++detectBackendFromEnvironment :: IO Backend+detectBackendFromEnvironment = do+  mRuntime <- lookupEnv "XDG_RUNTIME_DIR"+  mDisplay <- lookupEnv "DISPLAY"+  mSessionType <- lookupEnv "XDG_SESSION_TYPE"+  mWaylandDisplay <- lookupEnv "WAYLAND_DISPLAY"+   -- Validate the wayland socket.   let mWaylandPath = do         runtime <- mRuntime@@ -149,10 +214,7 @@    waylandOk <- case mWaylandPath of     Nothing -> pure False-    Just wlPath ->-      catchAny-        (isSocket <$> getFileStatus wlPath)-        (const $ pure False)+    Just wlPath -> isSocketPath wlPath    -- Clean up the environment when falling back to X11.   when (not waylandOk && maybe False (not . null) mDisplay) $ do@@ -166,5 +228,11 @@     setEnv "XDG_SESSION_TYPE" "wayland"    let selected = if waylandOk then BackendWayland else BackendX11-  logIO INFO $ "Detected backend: " ++ show selected+  logIO INFO $ "Detected backend from environment: " ++ show selected   pure selected++detectBackend :: IO Backend+detectBackend = do+  prepareBackendEnvironment+  mGdkBackend <- detectBackendFromGdk+  maybe detectBackendFromEnvironment pure mGdkBackend

@@ -0,0 +1,506 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Shared Claude Code subscription usage information.+--+-- Claude Code currently stores local transcript JSONL files under+-- @~/.claude/projects@. This module derives usage from those local transcripts+-- and reads subscription metadata from Claude Code's local state files. It does+-- not call an Anthropic billing endpoint.+module System.Taffybar.Information.AnthropicUsage+  ( AnthropicUsageConfig (..),+    defaultAnthropicUsageConfig,+    AnthropicUsageSnapshot (..),+    AnthropicUsageInfo (..),+    AnthropicUsageWindow (..),+    AnthropicUsageTotals (..),+    getAnthropicUsageInfo,+    updateAnthropicUsage,+    getAnthropicUsageChan,+    getAnthropicUsageState,+    forceAnthropicUsageRefresh,+  )+where++import Control.Applicative ((<|>))+import Control.Concurrent (forkIO)+import Control.Concurrent.MVar+import Control.Concurrent.STM (atomically, orElse)+import Control.Concurrent.STM.TChan+import Control.Exception (SomeException, try)+import Control.Monad (forever, void)+import Control.Monad.IO.Class (liftIO)+import Data.Aeson+import Data.Aeson.Types (Parser)+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.List (sortOn)+import Data.Maybe (fromMaybe, mapMaybe)+import qualified Data.Set as Set+import qualified Data.Text as T+import Data.Time.Clock+import System.Directory+  ( doesDirectoryExist,+    doesFileExist,+    getHomeDirectory,+    getModificationTime,+    listDirectory,+  )+import System.FilePath (takeExtension, (</>))+import System.Log.Logger (Priority (WARNING), logM)+import System.Taffybar.Context (TaffyIO, getStateDefault)+import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay)++data AnthropicUsageConfig = AnthropicUsageConfig+  { anthropicUsagePollInterval :: Double,+    anthropicUsageStatePath :: Maybe FilePath,+    anthropicUsageCredentialsPath :: Maybe FilePath,+    anthropicUsageProjectsPath :: Maybe FilePath,+    anthropicUsageFileLookbackSeconds :: NominalDiffTime,+    anthropicUsageFiveHourBudgetTokens :: Maybe Int,+    anthropicUsageWeeklyBudgetTokens :: Maybe Int+  }++defaultAnthropicUsageConfig :: AnthropicUsageConfig+defaultAnthropicUsageConfig =+  AnthropicUsageConfig+    { anthropicUsagePollInterval = 60 * 5,+      anthropicUsageStatePath = Nothing,+      anthropicUsageCredentialsPath = Nothing,+      anthropicUsageProjectsPath = Nothing,+      anthropicUsageFileLookbackSeconds = 8 * 24 * 60 * 60,+      anthropicUsageFiveHourBudgetTokens = Nothing,+      anthropicUsageWeeklyBudgetTokens = Nothing+    }++data AnthropicUsageSnapshot+  = AnthropicUsageAvailable AnthropicUsageInfo+  | AnthropicUsageUnavailable T.Text+  deriving (Eq, Show)++data AnthropicUsageInfo = AnthropicUsageInfo+  { anthropicUsageGeneratedAt :: UTCTime,+    anthropicUsageSubscriptionType :: Maybe T.Text,+    anthropicUsageRateLimitTier :: Maybe T.Text,+    anthropicUsageHasAvailableSubscription :: Maybe Bool,+    anthropicUsageExtraUsageDisabledReason :: Maybe T.Text,+    anthropicUsageOrganizationName :: Maybe T.Text,+    anthropicUsageFiveHourWindow :: AnthropicUsageWindow,+    anthropicUsageWeeklyWindow :: AnthropicUsageWindow+  }+  deriving (Eq, Show)++data AnthropicUsageWindow = AnthropicUsageWindow+  { anthropicUsageWindowName :: T.Text,+    anthropicUsageWindowStart :: UTCTime,+    anthropicUsageWindowEnd :: UTCTime,+    anthropicUsageWindowBudgetTokens :: Maybe Int,+    anthropicUsageWindowTotals :: AnthropicUsageTotals+  }+  deriving (Eq, Show)++data AnthropicUsageTotals = AnthropicUsageTotals+  { anthropicUsageRequestCount :: Int,+    anthropicUsageInputTokens :: Int,+    anthropicUsageCacheCreationTokens :: Int,+    anthropicUsageCacheReadTokens :: Int,+    anthropicUsageOutputTokens :: Int,+    anthropicUsageEstimatedCostUSD :: Maybe Double+  }+  deriving (Eq, Show)++instance Semigroup AnthropicUsageTotals where+  a <> b =+    AnthropicUsageTotals+      { anthropicUsageRequestCount = anthropicUsageRequestCount a + anthropicUsageRequestCount b,+        anthropicUsageInputTokens = anthropicUsageInputTokens a + anthropicUsageInputTokens b,+        anthropicUsageCacheCreationTokens = anthropicUsageCacheCreationTokens a + anthropicUsageCacheCreationTokens b,+        anthropicUsageCacheReadTokens = anthropicUsageCacheReadTokens a + anthropicUsageCacheReadTokens b,+        anthropicUsageOutputTokens = anthropicUsageOutputTokens a + anthropicUsageOutputTokens b,+        anthropicUsageEstimatedCostUSD =+          addMaybeDouble+            (anthropicUsageEstimatedCostUSD a)+            (anthropicUsageEstimatedCostUSD b)+      }++instance Monoid AnthropicUsageTotals where+  mempty =+    AnthropicUsageTotals+      { anthropicUsageRequestCount = 0,+        anthropicUsageInputTokens = 0,+        anthropicUsageCacheCreationTokens = 0,+        anthropicUsageCacheReadTokens = 0,+        anthropicUsageOutputTokens = 0,+        anthropicUsageEstimatedCostUSD = Nothing+      }++addMaybeDouble :: Maybe Double -> Maybe Double -> Maybe Double+addMaybeDouble Nothing Nothing = Nothing+addMaybeDouble a b = Just $ fromMaybe 0 a + fromMaybe 0 b++data AnthropicUsageMetadata = AnthropicUsageMetadata+  { anthropicMetadataSubscriptionType :: Maybe T.Text,+    anthropicMetadataRateLimitTier :: Maybe T.Text,+    anthropicMetadataHasAvailableSubscription :: Maybe Bool,+    anthropicMetadataExtraUsageDisabledReason :: Maybe T.Text,+    anthropicMetadataOrganizationName :: Maybe T.Text+  }+  deriving (Eq, Show)++data AnthropicCredentials = AnthropicCredentials+  { anthropicCredentialsSubscriptionType :: Maybe T.Text,+    anthropicCredentialsRateLimitTier :: Maybe T.Text+  }++instance FromJSON AnthropicCredentials where+  parseJSON = withObject "AnthropicCredentials" $ \root -> do+    oauth <- root .:? "claudeAiOauth"+    case oauth of+      Nothing -> return $ AnthropicCredentials Nothing Nothing+      Just value ->+        withObject+          "ClaudeAiOauth"+          ( \o ->+              AnthropicCredentials+                <$> o .:? "subscriptionType"+                <*> o .:? "rateLimitTier"+          )+          value++data AnthropicState = AnthropicState+  { anthropicStateHasAvailableSubscription :: Maybe Bool,+    anthropicStateExtraUsageDisabledReason :: Maybe T.Text,+    anthropicStateOrganizationName :: Maybe T.Text+  }++instance FromJSON AnthropicState where+  parseJSON = withObject "AnthropicState" $ \o -> do+    oauth <- o .:? "oauthAccount"+    organizationName <-+      maybe+        (return Nothing)+        (withObject "OauthAccount" (.:? "organizationName"))+        oauth+    AnthropicState+      <$> o .:? "hasAvailableSubscription"+      <*> o .:? "cachedExtraUsageDisabledReason"+      <*> pure organizationName++data TranscriptUsageEntry = TranscriptUsageEntry+  { transcriptUsageTimestamp :: UTCTime,+    transcriptUsageRequestId :: T.Text,+    transcriptUsageTotals :: AnthropicUsageTotals+  }+  deriving (Eq, Show)++data TranscriptJSON = TranscriptJSON+  { transcriptJSONTimestamp :: Maybe UTCTime,+    transcriptJSONRequestId :: Maybe T.Text,+    transcriptJSONUsage :: Maybe AnthropicUsageTotals,+    transcriptJSONCost :: Maybe Double+  }++instance FromJSON TranscriptJSON where+  parseJSON = withObject "TranscriptJSON" $ \o -> do+    message <- o .:? "message"+    usage <- parseMessageUsage message+    TranscriptJSON+      <$> o .:? "timestamp"+      <*> o .:? "requestId"+      <*> pure usage+      <*> o .:? "costUSD"++parseMessageUsage :: Maybe Value -> Parser (Maybe AnthropicUsageTotals)+parseMessageUsage Nothing = return Nothing+parseMessageUsage (Just value) =+  withObject+    "Message"+    ( \message ->+        message .:? "usage" >>= traverse parseJSON+    )+    value++instance FromJSON AnthropicUsageTotals where+  parseJSON = withObject "AnthropicUsageTotals" $ \o -> do+    input <- o .:? "input_tokens" .!= 0+    cacheCreation <- o .:? "cache_creation_input_tokens" .!= 0+    cacheRead <- o .:? "cache_read_input_tokens" .!= 0+    output <- o .:? "output_tokens" .!= 0+    return $+      AnthropicUsageTotals+        { anthropicUsageRequestCount = 1,+          anthropicUsageInputTokens = input,+          anthropicUsageCacheCreationTokens = cacheCreation,+          anthropicUsageCacheReadTokens = cacheRead,+          anthropicUsageOutputTokens = output,+          anthropicUsageEstimatedCostUSD = Nothing+        }++getAnthropicUsageInfo :: AnthropicUsageConfig -> IO AnthropicUsageInfo+getAnthropicUsageInfo config = do+  now <- getCurrentTime+  metadata <- readAnthropicUsageMetadata config+  entries <- readAnthropicTranscriptEntries config now+  let fiveHourWindow =+        buildActiveBlockWindow+          now+          "5h"+          (5 * 60 * 60)+          (anthropicUsageFiveHourBudgetTokens config)+          entries+      weeklyWindow =+        buildRollingWindow+          now+          "7d"+          (7 * 24 * 60 * 60)+          (anthropicUsageWeeklyBudgetTokens config)+          entries+  return $+    AnthropicUsageInfo+      { anthropicUsageGeneratedAt = now,+        anthropicUsageSubscriptionType = anthropicMetadataSubscriptionType metadata,+        anthropicUsageRateLimitTier = anthropicMetadataRateLimitTier metadata,+        anthropicUsageHasAvailableSubscription = anthropicMetadataHasAvailableSubscription metadata,+        anthropicUsageExtraUsageDisabledReason = anthropicMetadataExtraUsageDisabledReason metadata,+        anthropicUsageOrganizationName = anthropicMetadataOrganizationName metadata,+        anthropicUsageFiveHourWindow = fiveHourWindow,+        anthropicUsageWeeklyWindow = weeklyWindow+      }++updateAnthropicUsage :: AnthropicUsageConfig -> IO AnthropicUsageSnapshot+updateAnthropicUsage config = do+  result <- try $ getAnthropicUsageInfo config+  case result of+    Right info -> return $ AnthropicUsageAvailable info+    Left (err :: SomeException) -> do+      let message = T.pack $ show err+      logM logName WARNING $ "Anthropic usage update failed: " <> show err+      return $ AnthropicUsageUnavailable message++readAnthropicUsageMetadata :: AnthropicUsageConfig -> IO AnthropicUsageMetadata+readAnthropicUsageMetadata config = do+  credentials <- decodeFileIfExists =<< maybe defaultClaudeCredentialsPath return (anthropicUsageCredentialsPath config)+  state <- decodeFileIfExists =<< maybe defaultClaudeStatePath return (anthropicUsageStatePath config)+  return $+    AnthropicUsageMetadata+      { anthropicMetadataSubscriptionType = credentials >>= anthropicCredentialsSubscriptionType,+        anthropicMetadataRateLimitTier = credentials >>= anthropicCredentialsRateLimitTier,+        anthropicMetadataHasAvailableSubscription = state >>= anthropicStateHasAvailableSubscription,+        anthropicMetadataExtraUsageDisabledReason = state >>= anthropicStateExtraUsageDisabledReason,+        anthropicMetadataOrganizationName = state >>= anthropicStateOrganizationName+      }++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+    else return Nothing++defaultClaudeStatePath :: IO FilePath+defaultClaudeStatePath = do+  home <- getHomeDirectory+  return $ home </> ".claude.json"++defaultClaudeCredentialsPath :: IO FilePath+defaultClaudeCredentialsPath = do+  home <- getHomeDirectory+  return $ home </> ".claude" </> ".credentials.json"++defaultClaudeProjectsPath :: IO FilePath+defaultClaudeProjectsPath = do+  home <- getHomeDirectory+  return $ home </> ".claude" </> "projects"++readAnthropicTranscriptEntries :: AnthropicUsageConfig -> UTCTime -> IO [TranscriptUsageEntry]+readAnthropicTranscriptEntries config now = do+  projectsPath <- maybe defaultClaudeProjectsPath return (anthropicUsageProjectsPath config)+  exists <- doesDirectoryExist projectsPath+  if not exists+    then return []+    else do+      files <- jsonlFilesModifiedSince (addUTCTime (negate $ anthropicUsageFileLookbackSeconds config) now) projectsPath+      dedupeTranscriptEntries . concat <$> mapM readTranscriptFile files++jsonlFilesModifiedSince :: UTCTime -> FilePath -> IO [FilePath]+jsonlFilesModifiedSince cutoff path = do+  entries <- listDirectory path+  concat+    <$> mapM+      ( \entry -> do+          let child = path </> entry+          isDirectory <- doesDirectoryExist child+          isFile <- doesFileExist child+          if isDirectory+            then jsonlFilesModifiedSince cutoff child+            else+              if isFile && takeExtension child == ".jsonl"+                then do+                  modified <- getModificationTime child+                  return [child | modified >= cutoff]+                else return []+      )+      entries++readTranscriptFile :: FilePath -> IO [TranscriptUsageEntry]+readTranscriptFile path = do+  bytes <- LBS.readFile path+  return $+    mapMaybe+      (uncurry $ transcriptLineToEntry path)+      (zip [(1 :: Int) ..] (LBS.lines bytes))++transcriptLineToEntry :: FilePath -> Int -> LBS.ByteString -> Maybe TranscriptUsageEntry+transcriptLineToEntry path lineNumber bytes = do+  decoded <- either (const Nothing) Just $ eitherDecode bytes+  timestamp <- transcriptJSONTimestamp decoded+  usage <- transcriptJSONUsage decoded+  let requestId =+        fromMaybe+          (T.pack $ path <> ":" <> show lineNumber)+          (transcriptJSONRequestId decoded)+      usageWithCost =+        usage+          { anthropicUsageEstimatedCostUSD =+              transcriptJSONCost decoded+                <|> anthropicUsageEstimatedCostUSD usage+          }+  return $+    TranscriptUsageEntry+      { transcriptUsageTimestamp = timestamp,+        transcriptUsageRequestId = requestId,+        transcriptUsageTotals = usageWithCost+      }++dedupeTranscriptEntries :: [TranscriptUsageEntry] -> [TranscriptUsageEntry]+dedupeTranscriptEntries =+  snd+    . foldl+      ( \(seen, entries) entry ->+          let requestId = transcriptUsageRequestId entry+           in if Set.member requestId seen+                then (seen, entries)+                else (Set.insert requestId seen, entry : entries)+      )+      (Set.empty, [])++buildActiveBlockWindow ::+  UTCTime ->+  T.Text ->+  NominalDiffTime ->+  Maybe Int ->+  [TranscriptUsageEntry] ->+  AnthropicUsageWindow+buildActiveBlockWindow now name duration budget entries =+  case activeBlock now duration entries of+    Nothing ->+      AnthropicUsageWindow+        { anthropicUsageWindowName = name,+          anthropicUsageWindowStart = now,+          anthropicUsageWindowEnd = addUTCTime duration now,+          anthropicUsageWindowBudgetTokens = budget,+          anthropicUsageWindowTotals = mempty+        }+    Just (start, blockEntries) ->+      AnthropicUsageWindow+        { anthropicUsageWindowName = name,+          anthropicUsageWindowStart = start,+          anthropicUsageWindowEnd = addUTCTime duration start,+          anthropicUsageWindowBudgetTokens = budget,+          anthropicUsageWindowTotals = foldMap transcriptUsageTotals blockEntries+        }++activeBlock :: UTCTime -> NominalDiffTime -> [TranscriptUsageEntry] -> Maybe (UTCTime, [TranscriptUsageEntry])+activeBlock now duration entries =+  case foldl addToBlock Nothing (sortOn transcriptUsageTimestamp entries) of+    Nothing -> Nothing+    Just (start, blockEntries)+      | addUTCTime duration start >= now -> Just (start, blockEntries)+      | otherwise -> Nothing+  where+    addToBlock Nothing entry =+      Just (transcriptUsageTimestamp entry, [entry])+    addToBlock (Just (start, blockEntries)) entry+      | transcriptUsageTimestamp entry < addUTCTime duration start =+          Just (start, blockEntries <> [entry])+      | otherwise =+          Just (transcriptUsageTimestamp entry, [entry])++buildRollingWindow ::+  UTCTime ->+  T.Text ->+  NominalDiffTime ->+  Maybe Int ->+  [TranscriptUsageEntry] ->+  AnthropicUsageWindow+buildRollingWindow now name duration budget entries =+  let start = addUTCTime (negate duration) now+      windowEntries = filter ((>= start) . transcriptUsageTimestamp) entries+      windowStart = maybe start transcriptUsageTimestamp $ firstMaybe $ sortOn transcriptUsageTimestamp windowEntries+      windowEnd = addUTCTime duration windowStart+   in AnthropicUsageWindow+        { anthropicUsageWindowName = name,+          anthropicUsageWindowStart = windowStart,+          anthropicUsageWindowEnd = windowEnd,+          anthropicUsageWindowBudgetTokens = budget,+          anthropicUsageWindowTotals = foldMap transcriptUsageTotals windowEntries+        }++firstMaybe :: [a] -> Maybe a+firstMaybe [] = Nothing+firstMaybe (x : _) = Just x++newtype AnthropicUsageChanVar+  = AnthropicUsageChanVar+      ( TChan AnthropicUsageSnapshot,+        MVar AnthropicUsageSnapshot,+        TChan ()+      )++getAnthropicUsageChan :: AnthropicUsageConfig -> TaffyIO (TChan AnthropicUsageSnapshot)+getAnthropicUsageChan config = do+  AnthropicUsageChanVar (chan, _, _) <- setupAnthropicUsageChanVar config+  return chan++getAnthropicUsageState :: AnthropicUsageConfig -> TaffyIO AnthropicUsageSnapshot+getAnthropicUsageState config = do+  AnthropicUsageChanVar (_, var, _) <- setupAnthropicUsageChanVar config+  liftIO $ readMVar var++forceAnthropicUsageRefresh :: AnthropicUsageConfig -> TaffyIO ()+forceAnthropicUsageRefresh config = do+  AnthropicUsageChanVar (_, _, refreshChan) <- setupAnthropicUsageChanVar config+  liftIO $ atomically $ writeTChan refreshChan ()++setupAnthropicUsageChanVar :: AnthropicUsageConfig -> TaffyIO AnthropicUsageChanVar+setupAnthropicUsageChanVar config = getStateDefault $ do+  chan <- liftIO newBroadcastTChanIO+  refreshChan <- liftIO newTChanIO+  initial <- liftIO $ updateAnthropicUsage config+  var <- liftIO $ newMVar initial+  wakeupChan <- getWakeupChannelForDelay (anthropicUsagePollInterval config)+  ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan+  void $+    liftIO $+      forkIO $+        forever $ do+          atomically $+            void (readTChan refreshChan)+              `orElse` void (readTChan ourWakeupChan)+          refreshAnthropicUsageState config chan var+  return $ AnthropicUsageChanVar (chan, var, refreshChan)++refreshAnthropicUsageState ::+  AnthropicUsageConfig ->+  TChan AnthropicUsageSnapshot ->+  MVar AnthropicUsageSnapshot ->+  IO ()+refreshAnthropicUsageState config chan var = do+  snapshot <- updateAnthropicUsage config+  void $ swapMVar var snapshot+  atomically $ writeTChan chan snapshot++logName :: String+logName = "System.Taffybar.Information.AnthropicUsage"

@@ -37,12 +37,11 @@ import qualified Data.Text as T import System.Log.Logger (Priority (..), logM) import System.Taffybar.Context (TaffyIO, getStateDefault, taffyFork)-import System.Taffybar.Hyprland (getHyprlandEventChan)+import System.Taffybar.Hyprland (getHyprlandClient, getHyprlandEventChan) import qualified System.Taffybar.Information.Hyprland as Hypr import qualified System.Taffybar.Information.Hyprland.API as HyprAPI import qualified System.Taffybar.Information.Hyprland.Types as HyprTypes import System.Taffybar.Information.Layout.Model-import System.Taffybar.Hyprland (getHyprlandClient)  data HyprlandLayoutProviderConfig = HyprlandLayoutProviderConfig   { layoutSnapshotGetter :: TaffyIO T.Text,

@@ -0,0 +1,252 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Shared OpenAI Codex subscription usage information.+--+-- This module currently reads the ChatGPT OAuth token file written by Codex and+-- calls ChatGPT's Codex usage endpoint. That endpoint is not part of OpenAI's+-- public API, so callers can override the endpoint, auth path, and user agent.+module System.Taffybar.Information.OpenAIUsage+  ( OpenAIUsageConfig (..),+    defaultOpenAIUsageConfig,+    OpenAIUsageAuth (..),+    OpenAIUsageSnapshot (..),+    OpenAIUsageInfo (..),+    OpenAIUsageAdditionalRateLimit (..),+    OpenAIUsageRateLimit (..),+    OpenAIUsageWindow (..),+    OpenAIUsageCredits (..),+    getOpenAIUsageInfo,+    updateOpenAIUsage,+    getOpenAIUsageChan,+    getOpenAIUsageState,+    forceOpenAIUsageRefresh,+  )+where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar+import Control.Concurrent.STM (atomically, orElse)+import Control.Concurrent.STM.TChan+import Control.Exception (SomeException, try)+import Control.Monad (forever, void)+import Control.Monad.IO.Class (liftIO)+import Data.Aeson+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Network.HTTP.Simple+import System.Directory (doesFileExist, getHomeDirectory)+import System.Environment (lookupEnv)+import System.FilePath ((</>))+import System.Log.Logger (Priority (WARNING), logM)+import System.Taffybar.Context (TaffyIO, getStateDefault)+import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay)++data OpenAIUsageConfig = OpenAIUsageConfig+  { openAIUsagePollInterval :: Double,+    openAIUsageEndpoint :: String,+    openAIUsageUserAgent :: String,+    openAIUsageAuthPath :: Maybe FilePath+  }++defaultOpenAIUsageConfig :: OpenAIUsageConfig+defaultOpenAIUsageConfig =+  OpenAIUsageConfig+    { openAIUsagePollInterval = 60 * 15,+      openAIUsageEndpoint = "https://chatgpt.com/backend-api/codex/usage",+      openAIUsageUserAgent = "taffybar-openai-usage",+      openAIUsageAuthPath = Nothing+    }++data OpenAIUsageAuth = OpenAIUsageAuth+  { openAIUsageAccessToken :: T.Text,+    openAIUsageAccountId :: T.Text+  }++instance FromJSON OpenAIUsageAuth where+  parseJSON = withObject "OpenAIUsageAuth" $ \root -> do+    tokens <- root .: "tokens"+    OpenAIUsageAuth+      <$> tokens .: "access_token"+      <*> tokens .: "account_id"++data OpenAIUsageSnapshot+  = OpenAIUsageAvailable OpenAIUsageInfo+  | OpenAIUsageUnavailable T.Text+  deriving (Eq, Show)++data OpenAIUsageInfo = OpenAIUsageInfo+  { openAIUsagePlanType :: Maybe T.Text,+    openAIUsageRateLimit :: OpenAIUsageRateLimit,+    openAIUsageAdditionalRateLimits :: [OpenAIUsageAdditionalRateLimit],+    openAIUsageCredits :: Maybe OpenAIUsageCredits,+    openAIUsageReachedType :: Maybe T.Text+  }+  deriving (Eq, Show)++instance FromJSON OpenAIUsageInfo where+  parseJSON = withObject "OpenAIUsageInfo" $ \o ->+    OpenAIUsageInfo+      <$> o .:? "plan_type"+      <*> o .: "rate_limit"+      <*> o .:? "additional_rate_limits" .!= []+      <*> o .:? "credits"+      <*> o .:? "rate_limit_reached_type"++data OpenAIUsageAdditionalRateLimit = OpenAIUsageAdditionalRateLimit+  { openAIUsageAdditionalLimitName :: Maybe T.Text,+    openAIUsageAdditionalRateLimit :: OpenAIUsageRateLimit+  }+  deriving (Eq, Show)++instance FromJSON OpenAIUsageAdditionalRateLimit where+  parseJSON = withObject "OpenAIUsageAdditionalRateLimit" $ \o ->+    OpenAIUsageAdditionalRateLimit+      <$> o .:? "limit_name"+      <*> o .: "rate_limit"++data OpenAIUsageRateLimit = OpenAIUsageRateLimit+  { openAIUsageAllowed :: Bool,+    openAIUsageLimitReached :: Bool,+    openAIUsagePrimaryWindow :: Maybe OpenAIUsageWindow,+    openAIUsageSecondaryWindow :: Maybe OpenAIUsageWindow+  }+  deriving (Eq, Show)++instance FromJSON OpenAIUsageRateLimit where+  parseJSON = withObject "OpenAIUsageRateLimit" $ \o ->+    OpenAIUsageRateLimit+      <$> o .:? "allowed" .!= True+      <*> o .:? "limit_reached" .!= False+      <*> o .:? "primary_window"+      <*> o .:? "secondary_window"++data OpenAIUsageWindow = OpenAIUsageWindow+  { openAIUsageUsedPercent :: Int,+    openAIUsageWindowDurationSeconds :: Maybe Int,+    openAIUsageResetAfterSeconds :: Maybe Int+  }+  deriving (Eq, Show)++instance FromJSON OpenAIUsageWindow where+  parseJSON = withObject "OpenAIUsageWindow" $ \o ->+    OpenAIUsageWindow+      <$> o .: "used_percent"+      <*> o .:? "limit_window_seconds"+      <*> o .:? "reset_after_seconds"++data OpenAIUsageCredits = OpenAIUsageCredits+  { openAIUsageHasCredits :: Bool,+    openAIUsageCreditsUnlimited :: Bool,+    openAIUsageCreditsBalance :: Maybe T.Text+  }+  deriving (Eq, Show)++instance FromJSON OpenAIUsageCredits where+  parseJSON = withObject "OpenAIUsageCredits" $ \o ->+    OpenAIUsageCredits+      <$> o .:? "has_credits" .!= False+      <*> o .:? "unlimited" .!= False+      <*> o .:? "balance"++getOpenAIUsageInfo :: OpenAIUsageConfig -> IO OpenAIUsageInfo+getOpenAIUsageInfo config = do+  auth <- readOpenAIUsageAuth config+  fetchOpenAIUsage config auth++updateOpenAIUsage :: OpenAIUsageConfig -> IO OpenAIUsageSnapshot+updateOpenAIUsage config = do+  result <- try $ getOpenAIUsageInfo config+  case result of+    Right info -> return $ OpenAIUsageAvailable info+    Left (err :: SomeException) -> do+      let message = T.pack $ show err+      logM logName WARNING $ "OpenAI usage update failed: " <> show err+      return $ OpenAIUsageUnavailable message++readOpenAIUsageAuth :: OpenAIUsageConfig -> IO OpenAIUsageAuth+readOpenAIUsageAuth config = do+  path <- maybe defaultCodexAuthPath return (openAIUsageAuthPath config)+  bytes <- LBS.readFile path+  either fail return $ eitherDecode bytes++defaultCodexAuthPath :: IO FilePath+defaultCodexAuthPath = do+  codexHome <- lookupEnv "CODEX_HOME"+  case codexHome of+    Just dir -> return $ dir </> "auth.json"+    Nothing -> do+      home <- getHomeDirectory+      let path = home </> ".codex" </> "auth.json"+      exists <- doesFileExist path+      if exists+        then return path+        else fail "No Codex auth file found"++fetchOpenAIUsage :: OpenAIUsageConfig -> OpenAIUsageAuth -> IO OpenAIUsageInfo+fetchOpenAIUsage config auth = do+  request0 <- parseRequest $ openAIUsageEndpoint config+  let request =+        setRequestHeader "Authorization" ["Bearer " <> TE.encodeUtf8 (openAIUsageAccessToken auth)] $+          setRequestHeader "ChatGPT-Account-Id" [TE.encodeUtf8 (openAIUsageAccountId auth)] $+            setRequestHeader "Accept" ["application/json"] $+              setRequestHeader "User-Agent" [TE.encodeUtf8 (T.pack (openAIUsageUserAgent config))] request0+  response <- httpLBS request+  let statusCode = getResponseStatusCode response+      body = getResponseBody response+  if statusCode >= 200 && statusCode < 300+    then either fail return $ eitherDecode body+    else fail $ "OpenAI usage endpoint returned HTTP " <> show statusCode++newtype OpenAIUsageChanVar+  = OpenAIUsageChanVar+      ( TChan OpenAIUsageSnapshot,+        MVar OpenAIUsageSnapshot,+        TChan ()+      )++getOpenAIUsageChan :: OpenAIUsageConfig -> TaffyIO (TChan OpenAIUsageSnapshot)+getOpenAIUsageChan config = do+  OpenAIUsageChanVar (chan, _, _) <- setupOpenAIUsageChanVar config+  return chan++getOpenAIUsageState :: OpenAIUsageConfig -> TaffyIO OpenAIUsageSnapshot+getOpenAIUsageState config = do+  OpenAIUsageChanVar (_, var, _) <- setupOpenAIUsageChanVar config+  liftIO $ readMVar var++forceOpenAIUsageRefresh :: OpenAIUsageConfig -> TaffyIO ()+forceOpenAIUsageRefresh config = do+  OpenAIUsageChanVar (_, _, refreshChan) <- setupOpenAIUsageChanVar config+  liftIO $ atomically $ writeTChan refreshChan ()++setupOpenAIUsageChanVar :: OpenAIUsageConfig -> TaffyIO OpenAIUsageChanVar+setupOpenAIUsageChanVar config = getStateDefault $ do+  chan <- liftIO newBroadcastTChanIO+  refreshChan <- liftIO newTChanIO+  initial <- liftIO $ updateOpenAIUsage config+  var <- liftIO $ newMVar initial+  wakeupChan <- getWakeupChannelForDelay (openAIUsagePollInterval config)+  ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan+  void $+    liftIO $+      forkIO $+        forever $ do+          atomically $+            void (readTChan refreshChan)+              `orElse` void (readTChan ourWakeupChan)+          refreshOpenAIUsageState config chan var+  return $ OpenAIUsageChanVar (chan, var, refreshChan)++refreshOpenAIUsageState ::+  OpenAIUsageConfig ->+  TChan OpenAIUsageSnapshot ->+  MVar OpenAIUsageSnapshot ->+  IO ()+refreshOpenAIUsageState config chan var = do+  snapshot <- updateOpenAIUsage config+  void $ swapMVar var snapshot+  atomically $ writeTChan chan snapshot++logName :: String+logName = "System.Taffybar.Information.OpenAIUsage"

@@ -0,0 +1,476 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Widgets for displaying Claude Code subscription usage.+module System.Taffybar.Widget.AnthropicUsage+  ( AnthropicUsageDisplayMode (..),+    AnthropicUsageDisplayModeState,+    AnthropicUsageLabelConfig (..),+    AnthropicUsageStackConfig (..),+    AnthropicUsageWindowSelector (..),+    defaultAnthropicUsageLabelConfig,+    defaultAnthropicUsageStackConfig,+    anthropicUsageLabelNew,+    anthropicUsageLabelNewWith,+    anthropicUsageFiveHourWindowLabelNew,+    anthropicUsageWeeklyWindowLabelNew,+    anthropicUsageStackNew,+    anthropicUsageStackNewWith,+    anthropicUsageNew,+    anthropicUsageNewWith,+    formatAnthropicUsageWindowLabel,+    formatAnthropicUsageSummaryLabel,+  )+where++import Control.Concurrent (ThreadId, forkIO, killThread)+import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)+import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TChan (TChan, dupTChan, newBroadcastTChanIO, readTChan, writeTChan)+import Control.Monad (forM_, forever, void)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Reader (ask, runReaderT)+import Data.Maybe (catMaybes)+import qualified Data.Text as T+import Data.Time.Clock+import qualified GI.GLib as GLib+import qualified GI.Gtk as Gtk+import System.Taffybar.Context (TaffyIO, getStateDefault)+import System.Taffybar.Information.AnthropicUsage+import System.Taffybar.Util (postGUIASync)+import System.Taffybar.Widget.Util (widgetSetClassGI)+import Text.Printf (printf)++data AnthropicUsageDisplayMode+  = AnthropicUsageDisplayUsed+  | AnthropicUsageDisplayRemaining+  deriving (Eq, Show)++newtype AnthropicUsageDisplayModeState+  = AnthropicUsageDisplayModeState+      (MVar AnthropicUsageDisplayMode, TChan AnthropicUsageDisplayMode)++data AnthropicUsageLabelConfig = AnthropicUsageLabelConfig+  { anthropicUsageLabelInfoConfig :: AnthropicUsageConfig,+    anthropicUsageLabelDefaultDisplayMode :: AnthropicUsageDisplayMode,+    anthropicUsageLabelFallbackText :: T.Text,+    anthropicUsageLabelClass :: T.Text,+    anthropicUsageLabelFormatter :: AnthropicUsageDisplayMode -> AnthropicUsageInfo -> T.Text,+    anthropicUsageLabelUnavailableFormatter :: T.Text -> T.Text,+    anthropicUsageLabelTooltipFormatter :: AnthropicUsageDisplayMode -> AnthropicUsageSnapshot -> Maybe T.Text+  }++data AnthropicUsageWindowSelector+  = AnthropicUsageFiveHourWindow+  | AnthropicUsageWeeklyWindow+  deriving (Eq, Show)++data AnthropicUsageStackConfig = AnthropicUsageStackConfig+  { anthropicUsageStackInfoConfig :: AnthropicUsageConfig,+    anthropicUsageStackDefaultDisplayMode :: AnthropicUsageDisplayMode,+    anthropicUsageStackFallbackText :: T.Text+  }++defaultAnthropicUsageLabelConfig :: AnthropicUsageLabelConfig+defaultAnthropicUsageLabelConfig =+  AnthropicUsageLabelConfig+    { anthropicUsageLabelInfoConfig = defaultAnthropicUsageConfig,+      anthropicUsageLabelDefaultDisplayMode = AnthropicUsageDisplayUsed,+      anthropicUsageLabelFallbackText = "Claude n/a",+      anthropicUsageLabelClass = "anthropic-usage-label",+      anthropicUsageLabelFormatter = formatAnthropicUsageSummaryLabel,+      anthropicUsageLabelUnavailableFormatter = const "Claude n/a",+      anthropicUsageLabelTooltipFormatter = formatAnthropicUsageTooltip+    }++defaultAnthropicUsageStackConfig :: AnthropicUsageStackConfig+defaultAnthropicUsageStackConfig =+  AnthropicUsageStackConfig+    { anthropicUsageStackInfoConfig = defaultAnthropicUsageConfig,+      anthropicUsageStackDefaultDisplayMode = AnthropicUsageDisplayUsed,+      anthropicUsageStackFallbackText = "n/a"+    }++anthropicUsageNew :: TaffyIO Gtk.Widget+anthropicUsageNew = anthropicUsageLabelNew++anthropicUsageNewWith :: AnthropicUsageLabelConfig -> TaffyIO Gtk.Widget+anthropicUsageNewWith = anthropicUsageLabelNewWith++anthropicUsageLabelNew :: TaffyIO Gtk.Widget+anthropicUsageLabelNew = anthropicUsageLabelNewWith defaultAnthropicUsageLabelConfig++anthropicUsageFiveHourWindowLabelNew :: TaffyIO Gtk.Widget+anthropicUsageFiveHourWindowLabelNew =+  anthropicUsageLabelNewWith $+    windowLabelConfig AnthropicUsageFiveHourWindow defaultAnthropicUsageStackConfig++anthropicUsageWeeklyWindowLabelNew :: TaffyIO Gtk.Widget+anthropicUsageWeeklyWindowLabelNew =+  anthropicUsageLabelNewWith $+    windowLabelConfig AnthropicUsageWeeklyWindow defaultAnthropicUsageStackConfig++anthropicUsageStackNew :: TaffyIO Gtk.Widget+anthropicUsageStackNew = anthropicUsageStackNewWith defaultAnthropicUsageStackConfig++anthropicUsageStackNewWith :: AnthropicUsageStackConfig -> TaffyIO Gtk.Widget+anthropicUsageStackNewWith config = do+  fiveHour <- anthropicUsageLabelNewWith $ windowLabelConfig AnthropicUsageFiveHourWindow config+  weekly <- anthropicUsageLabelNewWith $ windowLabelConfig AnthropicUsageWeeklyWindow config+  liftIO $ do+    box <- Gtk.boxNew Gtk.OrientationVertical 0+    _ <- widgetSetClassGI box "anthropic-usage-stack"+    Gtk.boxPackStart box fiveHour False False 0+    Gtk.boxPackStart box weekly False False 0+    Gtk.widgetShowAll box+    Gtk.toWidget box++windowLabelConfig :: AnthropicUsageWindowSelector -> AnthropicUsageStackConfig -> AnthropicUsageLabelConfig+windowLabelConfig selector stackConfig =+  defaultAnthropicUsageLabelConfig+    { anthropicUsageLabelInfoConfig = anthropicUsageStackInfoConfig stackConfig,+      anthropicUsageLabelDefaultDisplayMode = anthropicUsageStackDefaultDisplayMode stackConfig,+      anthropicUsageLabelFallbackText = anthropicUsageStackFallbackText stackConfig,+      anthropicUsageLabelClass = "anthropic-usage-window-label",+      anthropicUsageLabelFormatter = formatAnthropicUsageWindowLabel selector,+      anthropicUsageLabelUnavailableFormatter = const (anthropicUsageStackFallbackText stackConfig)+    }++anthropicUsageLabelNewWith :: AnthropicUsageLabelConfig -> TaffyIO Gtk.Widget+anthropicUsageLabelNewWith config = do+  let infoConfig = anthropicUsageLabelInfoConfig config+  usageChan <- getAnthropicUsageChan infoConfig+  initialSnapshot <- getAnthropicUsageState infoConfig+  displayState <- getAnthropicUsageDisplayModeState (anthropicUsageLabelDefaultDisplayMode config)+  ctx <- ask++  liftIO $ do+    label <- Gtk.labelNew (Just (anthropicUsageLabelFallbackText config))+    ebox <- Gtk.eventBoxNew+    snapshotVar <- newMVar initialSnapshot+    let refreshNow = runReaderT (forceAnthropicUsageRefresh infoConfig) ctx+    _ <- widgetSetClassGI label (anthropicUsageLabelClass config)+    _ <- widgetSetClassGI ebox "anthropic-usage"+    Gtk.containerAdd ebox label+    updateLabelFromState config label displayState initialSnapshot++    void $ Gtk.onWidgetRealize ebox $ do+      usageThread <- forkUsageListener config label displayState snapshotVar usageChan+      modeThread <- forkDisplayModeListener config label displayState snapshotVar+      void $ Gtk.onWidgetUnrealize ebox $ do+        killThread usageThread+        killThread modeThread++    void $+      Gtk.onWidgetButtonPressEvent ebox $ \_event -> do+        refreshNow+        showUsageMenu ebox config label displayState snapshotVar refreshNow+        return True++    Gtk.widgetShowAll ebox+    Gtk.toWidget ebox++getAnthropicUsageDisplayModeState :: AnthropicUsageDisplayMode -> TaffyIO AnthropicUsageDisplayModeState+getAnthropicUsageDisplayModeState defaultMode =+  getStateDefault $ liftIO $ do+    modeVar <- newMVar defaultMode+    modeChan <- newBroadcastTChanIO+    return $ AnthropicUsageDisplayModeState (modeVar, modeChan)++forkUsageListener ::+  AnthropicUsageLabelConfig ->+  Gtk.Label ->+  AnthropicUsageDisplayModeState ->+  MVar AnthropicUsageSnapshot ->+  TChan AnthropicUsageSnapshot ->+  IO ThreadId+forkUsageListener config label displayState snapshotVar usageChan = do+  ourUsageChan <- atomically $ dupTChan usageChan+  forkIO $+    forever $ do+      snapshot <- atomically $ readTChan ourUsageChan+      void $ swapMVar snapshotVar snapshot+      updateLabelFromState config label displayState snapshot++forkDisplayModeListener ::+  AnthropicUsageLabelConfig ->+  Gtk.Label ->+  AnthropicUsageDisplayModeState ->+  MVar AnthropicUsageSnapshot ->+  IO ThreadId+forkDisplayModeListener config label displayState@(AnthropicUsageDisplayModeState (_, modeChan)) snapshotVar = do+  ourModeChan <- atomically $ dupTChan modeChan+  forkIO $+    forever $ do+      _ <- atomically $ readTChan ourModeChan+      snapshot <- readMVar snapshotVar+      updateLabelFromState config label displayState snapshot++updateLabelFromState ::+  AnthropicUsageLabelConfig ->+  Gtk.Label ->+  AnthropicUsageDisplayModeState ->+  AnthropicUsageSnapshot ->+  IO ()+updateLabelFromState config label displayState snapshot = do+  displayMode <- readDisplayMode displayState+  let labelText = formatSnapshotLabel config displayMode snapshot+      tooltipText = anthropicUsageLabelTooltipFormatter config displayMode snapshot+  postGUIASync $ do+    Gtk.labelSetText label labelText+    Gtk.widgetSetTooltipText label tooltipText++formatSnapshotLabel :: AnthropicUsageLabelConfig -> AnthropicUsageDisplayMode -> AnthropicUsageSnapshot -> T.Text+formatSnapshotLabel config mode snapshot =+  case snapshot of+    AnthropicUsageAvailable info -> anthropicUsageLabelFormatter config mode info+    AnthropicUsageUnavailable message -> anthropicUsageLabelUnavailableFormatter config message++readDisplayMode :: AnthropicUsageDisplayModeState -> IO AnthropicUsageDisplayMode+readDisplayMode (AnthropicUsageDisplayModeState (modeVar, _)) = readMVar modeVar++setDisplayMode :: AnthropicUsageDisplayModeState -> AnthropicUsageDisplayMode -> IO ()+setDisplayMode (AnthropicUsageDisplayModeState (modeVar, modeChan)) mode = do+  void $ swapMVar modeVar mode+  atomically $ writeTChan modeChan mode++toggleDisplayMode :: AnthropicUsageDisplayMode -> AnthropicUsageDisplayMode+toggleDisplayMode AnthropicUsageDisplayUsed = AnthropicUsageDisplayRemaining+toggleDisplayMode AnthropicUsageDisplayRemaining = AnthropicUsageDisplayUsed++formatAnthropicUsageSummaryLabel :: AnthropicUsageDisplayMode -> AnthropicUsageInfo -> T.Text+formatAnthropicUsageSummaryLabel displayMode info =+  let windows =+        T.intercalate+          " "+          [ formatWindowLabel displayMode (anthropicUsageFiveHourWindow info),+            formatWindowLabel displayMode (anthropicUsageWeeklyWindow info)+          ]+      unavailable = anthropicUsageHasAvailableSubscription info == Just False+   in (if unavailable then "Claude ! " else "Claude ") <> windows++formatAnthropicUsageWindowLabel :: AnthropicUsageWindowSelector -> AnthropicUsageDisplayMode -> AnthropicUsageInfo -> T.Text+formatAnthropicUsageWindowLabel selector displayMode info =+  formatWindowLabel displayMode (selectedWindow selector info)++formatAnthropicUsageTooltip :: AnthropicUsageDisplayMode -> AnthropicUsageSnapshot -> Maybe T.Text+formatAnthropicUsageTooltip displayMode snapshot =+  Just $+    case snapshot of+      AnthropicUsageUnavailable message -> "Unable to read Claude usage: " <> message+      AnthropicUsageAvailable info ->+        T.intercalate "\n" $+          catMaybes+            [ ("Plan: " <>) <$> anthropicUsageSubscriptionType info,+              ("Tier: " <>) <$> anthropicUsageRateLimitTier info,+              ("Organization: " <>) <$> anthropicUsageOrganizationName info,+              Just $ "Display: " <> displayModeText displayMode,+              Just $ "5h: " <> formatWindow displayMode (anthropicUsageGeneratedAt info) (anthropicUsageFiveHourWindow info),+              Just $ "7d: " <> formatWindow displayMode (anthropicUsageGeneratedAt info) (anthropicUsageWeeklyWindow info),+              formatSubscriptionStatus info,+              ("Extra usage disabled: " <>) <$> anthropicUsageExtraUsageDisabledReason info+            ]++showUsageMenu ::+  Gtk.EventBox ->+  AnthropicUsageLabelConfig ->+  Gtk.Label ->+  AnthropicUsageDisplayModeState ->+  MVar AnthropicUsageSnapshot ->+  IO () ->+  IO ()+showUsageMenu anchor config label displayState snapshotVar refreshNow = do+  currentEvent <- Gtk.getCurrentEvent+  snapshot <- readMVar snapshotVar+  displayMode <- readDisplayMode displayState+  menu <- Gtk.menuNew+  Gtk.menuAttachToWidget menu anchor Nothing++  appendInfoItem menu "Claude Code usage"+  appendSnapshotMenuItems menu displayMode snapshot++  appendSeparator menu+  toggleItem <-+    Gtk.menuItemNewWithLabel $+      "Display: "+        <> displayModeText displayMode+        <> " (toggle)"+  void $+    Gtk.onMenuItemActivate toggleItem $ do+      setDisplayMode displayState (toggleDisplayMode displayMode)+      readMVar snapshotVar >>= updateLabelFromState config label displayState+  Gtk.menuShellAppend menu toggleItem++  refreshItem <- Gtk.menuItemNewWithLabel ("Refresh" :: T.Text)+  void $ Gtk.onMenuItemActivate refreshItem refreshNow+  Gtk.menuShellAppend menu refreshItem++  void $+    Gtk.onWidgetHide menu $+      void $+        GLib.idleAdd GLib.PRIORITY_LOW $ do+          Gtk.widgetDestroy menu+          return False++  Gtk.widgetShowAll menu+  Gtk.menuPopupAtPointer menu currentEvent++appendInfoItem :: Gtk.Menu -> T.Text -> IO ()+appendInfoItem menu text = do+  item <- Gtk.menuItemNewWithLabel text+  Gtk.widgetSetSensitive item False+  Gtk.menuShellAppend menu item++appendSeparator :: Gtk.Menu -> IO ()+appendSeparator menu = do+  sep <- Gtk.separatorMenuItemNew+  Gtk.menuShellAppend menu sep++appendSnapshotMenuItems :: Gtk.Menu -> AnthropicUsageDisplayMode -> AnthropicUsageSnapshot -> IO ()+appendSnapshotMenuItems menu _ (AnthropicUsageUnavailable message) =+  appendMenuSection menu "Status" ["Unavailable: " <> message]+appendSnapshotMenuItems menu displayMode (AnthropicUsageAvailable info) = do+  appendMenuSection+    menu+    "Account"+    ( catMaybes+        [ ("Plan: " <>) <$> anthropicUsageSubscriptionType info,+          ("Tier: " <>) <$> anthropicUsageRateLimitTier info,+          ("Organization: " <>) <$> anthropicUsageOrganizationName info,+          formatSubscriptionStatus info,+          Just $ "Display: " <> displayModeText displayMode+        ]+    )+  appendMenuSection+    menu+    "5h Window"+    (formatWindowMenuLines displayMode (anthropicUsageGeneratedAt info) (anthropicUsageFiveHourWindow info))+  appendMenuSection+    menu+    "7d Window"+    (formatWindowMenuLines displayMode (anthropicUsageGeneratedAt info) (anthropicUsageWeeklyWindow info))+  appendMenuSection+    menu+    "Extra Usage"+    (catMaybes [("Disabled: " <>) <$> anthropicUsageExtraUsageDisabledReason info])++appendMenuSection :: Gtk.Menu -> T.Text -> [T.Text] -> IO ()+appendMenuSection _ _ [] = return ()+appendMenuSection menu title items = do+  appendSeparator menu+  appendInfoItem menu title+  forM_ items (appendInfoItem menu)++formatWindowMenuLines :: AnthropicUsageDisplayMode -> UTCTime -> AnthropicUsageWindow -> [T.Text]+formatWindowMenuLines displayMode generatedAt window =+  [ "Tokens: " <> formatTotalTokens (anthropicUsageWindowTotals window),+    "Requests: " <> T.pack (show $ anthropicUsageRequestCount $ anthropicUsageWindowTotals window),+    "Input: " <> formatCount (anthropicUsageInputTokens totals),+    "Cache write: " <> formatCount (anthropicUsageCacheCreationTokens totals),+    "Cache read: " <> formatCount (anthropicUsageCacheReadTokens totals),+    "Output: " <> formatCount (anthropicUsageOutputTokens totals),+    "Window: " <> formatDuration (round $ diffUTCTime (anthropicUsageWindowEnd window) (anthropicUsageWindowStart window)),+    "Resets in: " <> formatDuration (max 0 $ round $ diffUTCTime (anthropicUsageWindowEnd window) generatedAt),+    "Display: " <> formatWindowValue displayMode window+  ]+    <> catMaybes+      [ ("Budget: " <>) . formatCount <$> anthropicUsageWindowBudgetTokens window,+        ("Estimated cost: " <>) . formatCurrency <$> anthropicUsageEstimatedCostUSD totals+      ]+  where+    totals = anthropicUsageWindowTotals window++formatSubscriptionStatus :: AnthropicUsageInfo -> Maybe T.Text+formatSubscriptionStatus info =+  case anthropicUsageHasAvailableSubscription info of+    Nothing -> Nothing+    Just True -> Just "Subscription: available"+    Just False -> Just "Subscription: unavailable"++formatWindow :: AnthropicUsageDisplayMode -> UTCTime -> AnthropicUsageWindow -> T.Text+formatWindow displayMode generatedAt window =+  anthropicUsageWindowName window+    <> " "+    <> formatWindowValue displayMode window+    <> ", "+    <> T.pack (show $ anthropicUsageRequestCount $ anthropicUsageWindowTotals window)+    <> " req"+    <> ", resets in "+    <> formatDuration (max 0 $ round $ diffUTCTime (anthropicUsageWindowEnd window) generatedAt)++formatWindowLabel :: AnthropicUsageDisplayMode -> AnthropicUsageWindow -> T.Text+formatWindowLabel displayMode window =+  anthropicUsageWindowName window+    <> " "+    <> formatWindowValueWithIndicator displayMode window++formatWindowValue :: AnthropicUsageDisplayMode -> AnthropicUsageWindow -> T.Text+formatWindowValue displayMode window =+  case anthropicUsageWindowBudgetTokens window of+    Nothing -> formatCount $ displayTokens displayMode window+    Just budget -> T.pack $ printf "%d%%" $ displayPercent displayMode budget window++formatWindowValueWithIndicator :: AnthropicUsageDisplayMode -> AnthropicUsageWindow -> T.Text+formatWindowValueWithIndicator displayMode window =+  formatWindowValue displayMode window <> displayModeIndicator displayMode++displayTokens :: AnthropicUsageDisplayMode -> AnthropicUsageWindow -> Int+displayTokens AnthropicUsageDisplayUsed = windowTotalTokens+displayTokens AnthropicUsageDisplayRemaining =+  \window ->+    case anthropicUsageWindowBudgetTokens window of+      Nothing -> windowTotalTokens window+      Just budget -> max 0 $ budget - windowTotalTokens window++displayPercent :: AnthropicUsageDisplayMode -> Int -> AnthropicUsageWindow -> Int+displayPercent displayMode budget window+  | budget <= 0 = 0+  | otherwise =+      let usedPercent = round $ (fromIntegral (windowTotalTokens window) / fromIntegral budget :: Double) * 100+       in case displayMode of+            AnthropicUsageDisplayUsed -> usedPercent+            AnthropicUsageDisplayRemaining -> max 0 (100 - usedPercent)++windowTotalTokens :: AnthropicUsageWindow -> Int+windowTotalTokens window =+  let totals = anthropicUsageWindowTotals window+   in anthropicUsageInputTokens totals+        + anthropicUsageCacheCreationTokens totals+        + anthropicUsageCacheReadTokens totals+        + anthropicUsageOutputTokens totals++formatTotalTokens :: AnthropicUsageTotals -> T.Text+formatTotalTokens totals =+  formatCount $+    anthropicUsageInputTokens totals+      + anthropicUsageCacheCreationTokens totals+      + anthropicUsageCacheReadTokens totals+      + anthropicUsageOutputTokens totals++displayModeText :: AnthropicUsageDisplayMode -> T.Text+displayModeText AnthropicUsageDisplayUsed = "used"+displayModeText AnthropicUsageDisplayRemaining = "remaining"++displayModeIndicator :: AnthropicUsageDisplayMode -> T.Text+displayModeIndicator AnthropicUsageDisplayUsed = "u"+displayModeIndicator AnthropicUsageDisplayRemaining = "r"++selectedWindow :: AnthropicUsageWindowSelector -> AnthropicUsageInfo -> AnthropicUsageWindow+selectedWindow AnthropicUsageFiveHourWindow = anthropicUsageFiveHourWindow+selectedWindow AnthropicUsageWeeklyWindow = anthropicUsageWeeklyWindow++formatDuration :: Int -> T.Text+formatDuration seconds+  | seconds < 60 = T.pack $ printf "%ds" seconds+  | seconds < 3600 = T.pack $ printf "%dm" (seconds `div` 60)+  | seconds < 86400 = T.pack $ printf "%dh" (seconds `div` 3600)+  | otherwise = T.pack $ printf "%dd" (seconds `div` 86400)++formatCount :: Int -> T.Text+formatCount count+  | count >= 1_000_000 = T.pack $ printf "%.1fM" (fromIntegral count / 1_000_000 :: Double)+  | count >= 10_000 = T.pack $ printf "%dk" (count `div` 1_000)+  | count >= 1_000 = T.pack $ printf "%.1fk" (fromIntegral count / 1_000 :: Double)+  | otherwise = T.pack $ show count++formatCurrency :: Double -> T.Text+formatCurrency amount = T.pack $ printf "$%.2f" amount

@@ -0,0 +1,483 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Widgets for displaying OpenAI Codex subscription usage.+module System.Taffybar.Widget.OpenAIUsage+  ( OpenAIUsageDisplayMode (..),+    OpenAIUsageDisplayModeState,+    OpenAIUsageLabelConfig (..),+    OpenAIUsageStackConfig (..),+    OpenAIUsageWindowSelector (..),+    defaultOpenAIUsageLabelConfig,+    defaultOpenAIUsageStackConfig,+    openAIUsageLabelNew,+    openAIUsageLabelNewWith,+    openAIUsagePrimaryWindowLabelNew,+    openAIUsageSecondaryWindowLabelNew,+    openAIUsageStackNew,+    openAIUsageStackNewWith,+    openAIUsageNew,+    openAIUsageNewWith,+    formatOpenAIUsageWindowLabel,+    formatOpenAIUsageSummaryLabel,+  )+where++import Control.Concurrent (ThreadId, forkIO, killThread)+import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)+import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TChan (TChan, dupTChan, newBroadcastTChanIO, readTChan, writeTChan)+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 qualified Data.Text as T+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 (widgetSetClassGI)+import Text.Printf (printf)++data OpenAIUsageDisplayMode+  = OpenAIUsageDisplayUsed+  | OpenAIUsageDisplayRemaining+  deriving (Eq, Show)++newtype OpenAIUsageDisplayModeState+  = OpenAIUsageDisplayModeState+      (MVar OpenAIUsageDisplayMode, TChan OpenAIUsageDisplayMode)++data OpenAIUsageLabelConfig = OpenAIUsageLabelConfig+  { openAIUsageLabelInfoConfig :: OpenAIUsageConfig,+    openAIUsageLabelDefaultDisplayMode :: OpenAIUsageDisplayMode,+    openAIUsageLabelFallbackText :: T.Text,+    openAIUsageLabelClass :: T.Text,+    openAIUsageLabelFormatter :: OpenAIUsageDisplayMode -> OpenAIUsageInfo -> T.Text,+    openAIUsageLabelUnavailableFormatter :: T.Text -> T.Text,+    openAIUsageLabelTooltipFormatter :: OpenAIUsageDisplayMode -> OpenAIUsageSnapshot -> Maybe T.Text+  }++data OpenAIUsageWindowSelector+  = OpenAIUsagePrimaryWindow+  | OpenAIUsageSecondaryWindow+  deriving (Eq, Show)++data OpenAIUsageStackConfig = OpenAIUsageStackConfig+  { openAIUsageStackInfoConfig :: OpenAIUsageConfig,+    openAIUsageStackDefaultDisplayMode :: OpenAIUsageDisplayMode,+    openAIUsageStackFallbackText :: T.Text+  }++defaultOpenAIUsageLabelConfig :: OpenAIUsageLabelConfig+defaultOpenAIUsageLabelConfig =+  OpenAIUsageLabelConfig+    { openAIUsageLabelInfoConfig = defaultOpenAIUsageConfig,+      openAIUsageLabelDefaultDisplayMode = OpenAIUsageDisplayUsed,+      openAIUsageLabelFallbackText = "AI n/a",+      openAIUsageLabelClass = "openai-usage-label",+      openAIUsageLabelFormatter = formatOpenAIUsageSummaryLabel,+      openAIUsageLabelUnavailableFormatter = const "AI n/a",+      openAIUsageLabelTooltipFormatter = formatOpenAIUsageTooltip+    }++defaultOpenAIUsageStackConfig :: OpenAIUsageStackConfig+defaultOpenAIUsageStackConfig =+  OpenAIUsageStackConfig+    { openAIUsageStackInfoConfig = defaultOpenAIUsageConfig,+      openAIUsageStackDefaultDisplayMode = OpenAIUsageDisplayUsed,+      openAIUsageStackFallbackText = "n/a"+    }++openAIUsageNew :: TaffyIO Gtk.Widget+openAIUsageNew = openAIUsageLabelNew++openAIUsageNewWith :: OpenAIUsageLabelConfig -> TaffyIO Gtk.Widget+openAIUsageNewWith = openAIUsageLabelNewWith++openAIUsageLabelNew :: TaffyIO Gtk.Widget+openAIUsageLabelNew = openAIUsageLabelNewWith defaultOpenAIUsageLabelConfig++openAIUsagePrimaryWindowLabelNew :: TaffyIO Gtk.Widget+openAIUsagePrimaryWindowLabelNew =+  openAIUsageLabelNewWith $+    windowLabelConfig OpenAIUsagePrimaryWindow defaultOpenAIUsageStackConfig++openAIUsageSecondaryWindowLabelNew :: TaffyIO Gtk.Widget+openAIUsageSecondaryWindowLabelNew =+  openAIUsageLabelNewWith $+    windowLabelConfig OpenAIUsageSecondaryWindow defaultOpenAIUsageStackConfig++openAIUsageStackNew :: TaffyIO Gtk.Widget+openAIUsageStackNew = openAIUsageStackNewWith defaultOpenAIUsageStackConfig++openAIUsageStackNewWith :: OpenAIUsageStackConfig -> TaffyIO Gtk.Widget+openAIUsageStackNewWith config = do+  primary <- openAIUsageLabelNewWith $ windowLabelConfig OpenAIUsagePrimaryWindow config+  secondary <- openAIUsageLabelNewWith $ windowLabelConfig OpenAIUsageSecondaryWindow config+  liftIO $ do+    box <- Gtk.boxNew Gtk.OrientationVertical 0+    _ <- widgetSetClassGI box "openai-usage-stack"+    Gtk.boxPackStart box primary False False 0+    Gtk.boxPackStart box secondary False False 0+    Gtk.widgetShowAll box+    Gtk.toWidget box++windowLabelConfig :: OpenAIUsageWindowSelector -> OpenAIUsageStackConfig -> OpenAIUsageLabelConfig+windowLabelConfig selector stackConfig =+  defaultOpenAIUsageLabelConfig+    { openAIUsageLabelInfoConfig = openAIUsageStackInfoConfig stackConfig,+      openAIUsageLabelDefaultDisplayMode = openAIUsageStackDefaultDisplayMode stackConfig,+      openAIUsageLabelFallbackText = openAIUsageStackFallbackText stackConfig,+      openAIUsageLabelClass = "openai-usage-window-label",+      openAIUsageLabelFormatter = formatOpenAIUsageWindowLabel selector,+      openAIUsageLabelUnavailableFormatter = const (openAIUsageStackFallbackText stackConfig)+    }++openAIUsageLabelNewWith :: OpenAIUsageLabelConfig -> TaffyIO Gtk.Widget+openAIUsageLabelNewWith config = do+  let infoConfig = openAIUsageLabelInfoConfig config+  usageChan <- getOpenAIUsageChan infoConfig+  initialSnapshot <- getOpenAIUsageState infoConfig+  displayState <- getOpenAIUsageDisplayModeState (openAIUsageLabelDefaultDisplayMode config)+  ctx <- ask++  liftIO $ do+    label <- Gtk.labelNew (Just (openAIUsageLabelFallbackText config))+    ebox <- Gtk.eventBoxNew+    snapshotVar <- newMVar initialSnapshot+    let refreshNow = runReaderT (forceOpenAIUsageRefresh infoConfig) ctx+    _ <- widgetSetClassGI label (openAIUsageLabelClass config)+    _ <- widgetSetClassGI ebox "openai-usage"+    Gtk.containerAdd ebox label+    updateLabelFromState config label displayState initialSnapshot++    void $ Gtk.onWidgetRealize ebox $ do+      usageThread <- forkUsageListener config label displayState snapshotVar usageChan+      modeThread <- forkDisplayModeListener config label displayState snapshotVar+      void $ Gtk.onWidgetUnrealize ebox $ do+        killThread usageThread+        killThread modeThread++    void $+      Gtk.onWidgetButtonPressEvent ebox $ \_event -> do+        refreshNow+        showUsageMenu ebox config label displayState snapshotVar refreshNow+        return True++    Gtk.widgetShowAll ebox+    Gtk.toWidget ebox++getOpenAIUsageDisplayModeState :: OpenAIUsageDisplayMode -> TaffyIO OpenAIUsageDisplayModeState+getOpenAIUsageDisplayModeState defaultMode =+  getStateDefault $ liftIO $ do+    modeVar <- newMVar defaultMode+    modeChan <- newBroadcastTChanIO+    return $ OpenAIUsageDisplayModeState (modeVar, modeChan)++forkUsageListener ::+  OpenAIUsageLabelConfig ->+  Gtk.Label ->+  OpenAIUsageDisplayModeState ->+  MVar OpenAIUsageSnapshot ->+  TChan OpenAIUsageSnapshot ->+  IO ThreadId+forkUsageListener config label displayState snapshotVar usageChan = do+  ourUsageChan <- atomically $ dupTChan usageChan+  forkIO $+    forever $ do+      snapshot <- atomically $ readTChan ourUsageChan+      void $ swapMVar snapshotVar snapshot+      updateLabelFromState config label displayState snapshot++forkDisplayModeListener ::+  OpenAIUsageLabelConfig ->+  Gtk.Label ->+  OpenAIUsageDisplayModeState ->+  MVar OpenAIUsageSnapshot ->+  IO ThreadId+forkDisplayModeListener config label displayState@(OpenAIUsageDisplayModeState (_, modeChan)) snapshotVar = do+  ourModeChan <- atomically $ dupTChan modeChan+  forkIO $+    forever $ do+      _ <- atomically $ readTChan ourModeChan+      snapshot <- readMVar snapshotVar+      updateLabelFromState config label displayState snapshot++updateLabelFromState ::+  OpenAIUsageLabelConfig ->+  Gtk.Label ->+  OpenAIUsageDisplayModeState ->+  OpenAIUsageSnapshot ->+  IO ()+updateLabelFromState config label displayState snapshot = do+  displayMode <- readDisplayMode displayState+  let labelText = formatSnapshotLabel config displayMode snapshot+      tooltipText = openAIUsageLabelTooltipFormatter config displayMode snapshot+  postGUIASync $ do+    Gtk.labelSetText label labelText+    Gtk.widgetSetTooltipText label tooltipText++formatSnapshotLabel :: OpenAIUsageLabelConfig -> OpenAIUsageDisplayMode -> OpenAIUsageSnapshot -> T.Text+formatSnapshotLabel config mode snapshot =+  case snapshot of+    OpenAIUsageAvailable info -> openAIUsageLabelFormatter config mode info+    OpenAIUsageUnavailable message -> openAIUsageLabelUnavailableFormatter config message++readDisplayMode :: OpenAIUsageDisplayModeState -> IO OpenAIUsageDisplayMode+readDisplayMode (OpenAIUsageDisplayModeState (modeVar, _)) = readMVar modeVar++setDisplayMode :: OpenAIUsageDisplayModeState -> OpenAIUsageDisplayMode -> IO ()+setDisplayMode (OpenAIUsageDisplayModeState (modeVar, modeChan)) mode = do+  void $ swapMVar modeVar mode+  atomically $ writeTChan modeChan mode++toggleDisplayMode :: OpenAIUsageDisplayMode -> OpenAIUsageDisplayMode+toggleDisplayMode OpenAIUsageDisplayUsed = OpenAIUsageDisplayRemaining+toggleDisplayMode OpenAIUsageDisplayRemaining = OpenAIUsageDisplayUsed++formatOpenAIUsageSummaryLabel :: OpenAIUsageDisplayMode -> OpenAIUsageInfo -> T.Text+formatOpenAIUsageSummaryLabel displayMode info =+  let limit = openAIUsageRateLimit info+      windows =+        T.intercalate+          " "+          [ fromMaybeText "5h" $ formatWindowLabel displayMode "5h" <$> openAIUsagePrimaryWindow limit,+            fromMaybeText "7d" $ formatWindowLabel displayMode "7d" <$> openAIUsageSecondaryWindow limit+          ]+      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++formatOpenAIUsageTooltip :: OpenAIUsageDisplayMode -> OpenAIUsageSnapshot -> Maybe T.Text+formatOpenAIUsageTooltip displayMode snapshot =+  Just $+    case snapshot of+      OpenAIUsageUnavailable message -> "Unable to fetch OpenAI usage: " <> message+      OpenAIUsageAvailable info ->+        T.intercalate "\n" $+          catMaybes+            [ ("Plan: " <>) <$> openAIUsagePlanType info,+              Just $ "Display: " <> displayModeText displayMode,+              Just $ "Default: " <> formatRateLimit displayMode (openAIUsageRateLimit info),+              formatAdditionalTooltip displayMode (openAIUsageAdditionalRateLimits info),+              formatCredits <$> openAIUsageCredits info,+              ("Reached: " <>) <$> openAIUsageReachedType info+            ]++showUsageMenu ::+  Gtk.EventBox ->+  OpenAIUsageLabelConfig ->+  Gtk.Label ->+  OpenAIUsageDisplayModeState ->+  MVar OpenAIUsageSnapshot ->+  IO () ->+  IO ()+showUsageMenu anchor config label displayState snapshotVar refreshNow = do+  currentEvent <- Gtk.getCurrentEvent+  snapshot <- readMVar snapshotVar+  displayMode <- readDisplayMode displayState+  menu <- Gtk.menuNew+  Gtk.menuAttachToWidget menu anchor Nothing++  appendInfoItem menu "OpenAI Codex usage"+  appendSnapshotMenuItems menu displayMode snapshot++  appendSeparator menu+  toggleItem <-+    Gtk.menuItemNewWithLabel $+      "Display: "+        <> displayModeText displayMode+        <> " (toggle)"+  void $+    Gtk.onMenuItemActivate toggleItem $ do+      setDisplayMode displayState (toggleDisplayMode displayMode)+      readMVar snapshotVar >>= updateLabelFromState config label displayState+  Gtk.menuShellAppend menu toggleItem++  refreshItem <- Gtk.menuItemNewWithLabel ("Refresh" :: T.Text)+  void $ Gtk.onMenuItemActivate refreshItem refreshNow+  Gtk.menuShellAppend menu refreshItem++  void $+    Gtk.onWidgetHide menu $+      void $+        GLib.idleAdd GLib.PRIORITY_LOW $ do+          Gtk.widgetDestroy menu+          return False++  Gtk.widgetShowAll menu+  Gtk.menuPopupAtPointer menu currentEvent++appendInfoItem :: Gtk.Menu -> T.Text -> IO ()+appendInfoItem menu text = do+  item <- Gtk.menuItemNewWithLabel text+  Gtk.widgetSetSensitive item False+  Gtk.menuShellAppend menu item++appendSeparator :: Gtk.Menu -> IO ()+appendSeparator menu = do+  sep <- Gtk.separatorMenuItemNew+  Gtk.menuShellAppend menu sep++appendSnapshotMenuItems :: Gtk.Menu -> OpenAIUsageDisplayMode -> OpenAIUsageSnapshot -> IO ()+appendSnapshotMenuItems menu _ (OpenAIUsageUnavailable message) =+  appendMenuSection menu "Status" ["Unavailable: " <> message]+appendSnapshotMenuItems menu displayMode (OpenAIUsageAvailable info) = do+  appendMenuSection+    menu+    "Account"+    ( catMaybes+        [ ("Plan: " <>) <$> openAIUsagePlanType info,+          Just $ "Display: " <> displayModeText displayMode+        ]+    )+  appendMenuSection+    menu+    "Default Limit"+    (formatRateLimitMenuLines displayMode (openAIUsageRateLimit info))+  appendMenuSection+    menu+    "Credits"+    (catMaybes [formatCredits <$> openAIUsageCredits info])+  appendMenuSection+    menu+    "Limit Reached"+    (catMaybes [("Type: " <>) <$> openAIUsageReachedType info])+  forM_ (openAIUsageAdditionalRateLimits info) $ \additional ->+    appendMenuSection+      menu+      (fromMaybeText "Additional Limit" (openAIUsageAdditionalLimitName additional))+      (formatRateLimitMenuLines displayMode (openAIUsageAdditionalRateLimit additional))++appendMenuSection :: Gtk.Menu -> T.Text -> [T.Text] -> IO ()+appendMenuSection _ _ [] = return ()+appendMenuSection menu title items = do+  appendSeparator menu+  appendInfoItem menu title+  forM_ items (appendInfoItem menu)++formatRateLimitMenuLines :: OpenAIUsageDisplayMode -> OpenAIUsageRateLimit -> [T.Text]+formatRateLimitMenuLines displayMode limit =+  catMaybes+    [ formatWindowMenuLine displayMode "5h" <$> openAIUsagePrimaryWindow limit,+      formatWindowMenuLine displayMode "7d" <$> openAIUsageSecondaryWindow limit+    ]+    <> [formatRateLimitStatus limit]++formatWindowMenuLine :: OpenAIUsageDisplayMode -> T.Text -> OpenAIUsageWindow -> T.Text+formatWindowMenuLine displayMode fallbackName window =+  formatWindowName fallbackName window+    <> ": "+    <> formatWindowPercent displayMode window+    <> " "+    <> displayModeText displayMode+    <> maybe "" ((", resets in " <>) . formatDuration) (openAIUsageResetAfterSeconds window)++formatRateLimitStatus :: OpenAIUsageRateLimit -> T.Text+formatRateLimitStatus limit+  | openAIUsageLimitReached limit = "Status: reached"+  | not (openAIUsageAllowed limit) = "Status: blocked"+  | otherwise = "Status: allowed"++formatAdditionalTooltip :: OpenAIUsageDisplayMode -> [OpenAIUsageAdditionalRateLimit] -> Maybe T.Text+formatAdditionalTooltip _ [] = Nothing+formatAdditionalTooltip displayMode additional =+  Just $ T.intercalate "\n" $ map (formatAdditional displayMode) additional++formatAdditional :: OpenAIUsageDisplayMode -> OpenAIUsageAdditionalRateLimit -> T.Text+formatAdditional displayMode additional =+  fromMaybeText "Additional" (openAIUsageAdditionalLimitName additional)+    <> ": "+    <> formatRateLimit displayMode (openAIUsageAdditionalRateLimit additional)++formatRateLimit :: OpenAIUsageDisplayMode -> OpenAIUsageRateLimit -> T.Text+formatRateLimit displayMode limit =+  let windows =+        T.intercalate+          ", "+          ( mapMaybe+              (uncurry (formatWindow displayMode))+              [ ("short", openAIUsagePrimaryWindow limit),+                ("long", openAIUsageSecondaryWindow limit)+              ]+          )+      status+        | openAIUsageLimitReached limit = "reached"+        | not (openAIUsageAllowed limit) = "blocked"+        | otherwise = "allowed"+   in windows <> " (" <> status <> ")"++formatWindow :: OpenAIUsageDisplayMode -> T.Text -> Maybe OpenAIUsageWindow -> Maybe T.Text+formatWindow _ _ Nothing = Nothing+formatWindow displayMode name (Just window) =+  Just $+    formatWindowName name window+      <> " "+      <> formatWindowPercent displayMode window+      <> " "+      <> displayModeText displayMode+      <> maybe "" ((" / " <>) . formatDuration) (openAIUsageWindowDurationSeconds window)+      <> maybe "" ((", resets in " <>) . formatDuration) (openAIUsageResetAfterSeconds window)++formatWindowLabel :: OpenAIUsageDisplayMode -> T.Text -> OpenAIUsageWindow -> T.Text+formatWindowLabel displayMode fallbackName window =+  formatWindowName fallbackName window+    <> " "+    <> formatWindowPercentWithIndicator displayMode window++formatWindowName :: T.Text -> OpenAIUsageWindow -> T.Text+formatWindowName fallbackName window =+  maybe fallbackName formatDuration (openAIUsageWindowDurationSeconds window)++formatWindowPercent :: OpenAIUsageDisplayMode -> OpenAIUsageWindow -> T.Text+formatWindowPercent displayMode window =+  T.pack $ printf "%d%%" $ displayPercent displayMode window++formatWindowPercentWithIndicator :: OpenAIUsageDisplayMode -> OpenAIUsageWindow -> T.Text+formatWindowPercentWithIndicator displayMode window =+  formatWindowPercent displayMode window <> displayModeIndicator displayMode++displayPercent :: OpenAIUsageDisplayMode -> OpenAIUsageWindow -> Int+displayPercent OpenAIUsageDisplayUsed = openAIUsageUsedPercent+displayPercent OpenAIUsageDisplayRemaining = max 0 . (100 -) . openAIUsageUsedPercent++displayModeText :: OpenAIUsageDisplayMode -> T.Text+displayModeText OpenAIUsageDisplayUsed = "used"+displayModeText OpenAIUsageDisplayRemaining = "remaining"++displayModeIndicator :: OpenAIUsageDisplayMode -> T.Text+displayModeIndicator OpenAIUsageDisplayUsed = "u"+displayModeIndicator OpenAIUsageDisplayRemaining = "r"++formatCredits :: OpenAIUsageCredits -> T.Text+formatCredits credits =+  "Credits: "+    <> ( if openAIUsageCreditsUnlimited credits+           then "unlimited"+           else fromMaybeText "0" (openAIUsageCreditsBalance credits)+       )+    <> if openAIUsageHasCredits credits then " available" else ""++selectedWindow :: OpenAIUsageWindowSelector -> OpenAIUsageRateLimit -> Maybe OpenAIUsageWindow+selectedWindow OpenAIUsagePrimaryWindow = openAIUsagePrimaryWindow+selectedWindow OpenAIUsageSecondaryWindow = openAIUsageSecondaryWindow++windowSelectorFallbackName :: OpenAIUsageWindowSelector -> T.Text+windowSelectorFallbackName OpenAIUsagePrimaryWindow = "5h"+windowSelectorFallbackName OpenAIUsageSecondaryWindow = "7d"++formatDuration :: Int -> T.Text+formatDuration seconds+  | seconds < 60 = T.pack $ printf "%ds" seconds+  | seconds < 3600 = T.pack $ printf "%dm" (seconds `div` 60)+  | seconds < 86400 = T.pack $ printf "%dh" (seconds `div` 3600)+  | otherwise = T.pack $ printf "%dd" (seconds `div` 86400)++fromMaybeText :: T.Text -> Maybe T.Text -> T.Text+fromMaybeText = fromMaybe

@@ -52,11 +52,11 @@ import Control.Monad.Trans.Reader (ask, asks, runReaderT) import Data.Default (Default (..)) import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Int (Int32) import Data.List (elemIndex) import qualified Data.Map.Strict as M import qualified Data.Text as T import Data.Word (Word64)-import Data.Int (Int32) import qualified GI.Gdk.Enums as Gdk import qualified GI.Gdk.Structs.EventScroll as Gdk import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk

@@ -1,6 +1,6 @@ cabal-version: 3.4 name: taffybar-version: 7.0.1+version: 7.1.0 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD-3-Clause license-file: LICENSE@@ -137,6 +137,7 @@                  , System.Taffybar.Information.Hyprland                  , System.Taffybar.Information.PulseAudio                  , System.Taffybar.Information.WirePlumber+                 , System.Taffybar.Information.AnthropicUsage                  , System.Taffybar.Information.Backlight                  , System.Taffybar.Information.ASUS                  , System.Taffybar.Information.Battery@@ -157,6 +158,7 @@                  , System.Taffybar.Information.Network                  , System.Taffybar.Information.Temperature                  , System.Taffybar.Information.NetworkManager+                 , System.Taffybar.Information.OpenAIUsage                  , System.Taffybar.Information.PowerProfiles                  , System.Taffybar.Information.Privacy                  , System.Taffybar.Information.ScreenLock@@ -176,6 +178,7 @@                  , System.Taffybar.Util                  , System.Taffybar.Widget                  , System.Taffybar.Widget.PulseAudio+                 , System.Taffybar.Widget.AnthropicUsage                  , System.Taffybar.Widget.ASUS                  , System.Taffybar.Widget.Backlight                  , System.Taffybar.Widget.Battery@@ -210,6 +213,7 @@                  , System.Taffybar.Widget.MPRIS2                  , System.Taffybar.Widget.NetworkGraph                  , System.Taffybar.Widget.NetworkManager+                 , System.Taffybar.Widget.OpenAIUsage                  , System.Taffybar.Widget.PowerProfiles                  , System.Taffybar.Widget.Privacy                  , System.Taffybar.Widget.ScreenLock@@ -390,6 +394,7 @@                , hspec                , hspec-core                , hspec-golden+               , network                , taffybar                , taffybar:testlib                , typed-process

@@ -24,18 +24,19 @@   ) where -import Control.Exception (SomeException, catch)+import Control.Exception (SomeException, bracket, catch) import Control.Monad.Trans.Reader (runReaderT) import Data.Default (def) import Data.Ratio ((%)) import GHC.Generics (Generic) import GI.Gtk (Widget)+import Network.Socket qualified as Socket import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removePathForcibly) import System.FilePath ((</>)) import System.Taffybar.Context import System.Taffybar.SimpleConfig import System.Taffybar.Test.DBusSpec (withTestDBus)-import System.Taffybar.Test.UtilSpec (logSetup, withSetEnv)+import System.Taffybar.Test.UtilSpec (logSetup, withEnv, withSetEnv) import System.Taffybar.Test.XvfbSpec (setDefaultDisplay_, withXdummy) import System.Taffybar.Widget.SimpleClock (textClockNewWith) import System.Taffybar.Widget.Workspaces (workspacesNew)@@ -47,6 +48,23 @@ spec :: Spec spec = logSetup $ sequential $ aroundAll_ withTestDBus $ aroundAll_ (withXdummy . flip setDefaultDisplay_) $ do   describe "detectBackend" $ do+    it "prefers an explicit X11 session over a discovered Wayland socket" $ do+      tmp <- getTemporaryDirectory+      let runtime = tmp </> "taffybar-test-runtime-x11-with-wayland-socket"+          wlPath = runtime </> "wayland-0"+      removePathForcibly runtime `catch` (\(_ :: SomeException) -> pure ())+      createDirectoryIfMissing True runtime+      withUnixSocket wlPath+        $ withEnv+          [ ("XDG_RUNTIME_DIR", const $ Just runtime),+            ("DISPLAY", const $ Just ":0"),+            ("XDG_SESSION_TYPE", const $ Just "x11"),+            ("WAYLAND_DISPLAY", const Nothing),+            ("HYPRLAND_INSTANCE_SIGNATURE", const Nothing)+          ]+        $ detectBackend `shouldReturn` BackendX11+      removePathForcibly runtime `catch` (\(_ :: SomeException) -> pure ())+     it "falls back to X11 when WAYLAND_DISPLAY is set but the socket is missing" $ do       tmp <- getTemporaryDirectory       let runtime = tmp </> "taffybar-test-runtime-missing-socket"@@ -82,6 +100,17 @@   describe "Fuzz tests" $ do     prop "eval generators" prop_genSimpleConfig     xprop "TaffybarConfig" prop_taffybarConfig++------------------------------------------------------------------------++withUnixSocket :: FilePath -> IO a -> IO a+withUnixSocket path action =+  bracket+    (Socket.socket Socket.AF_UNIX Socket.Stream Socket.defaultProtocol)+    Socket.close+    $ \sock -> do+      Socket.bind sock (Socket.SockAddrUnix path)+      action  ------------------------------------------------------------------------ 

@@ -1,6 +1,5 @@ module System.Taffybar.Information.Workspaces.EWMHSpec (spec) where -import Data.List (elem) import System.Taffybar.Information.Workspaces.EWMH   ( defaultEWMHWorkspaceProviderConfig,     workspaceUpdateEvents,