taffybar-4.1.2: src/System/Taffybar/Widget/Temperature.hs
--------------------------------------------------------------------------------
-- |
-- Module : System.Taffybar.Widget.Temperature
-- Copyright : (c) Ivan Malison
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Ivan Malison <IvanMalison@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- A widget for displaying system temperature. Monitors thermal zones and/or
-- hwmon devices and displays the current temperature with configurable
-- thresholds for warning and critical states.
--
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module System.Taffybar.Widget.Temperature
( -- * Combined icon+label widget
temperatureNew
, temperatureNewWith
-- * Icon-only widget
, temperatureIconNew
, temperatureIconNewWith
-- * Label-only widget
, temperatureLabelNew
, temperatureLabelNewWith
-- * Configuration
, TemperatureConfig(..)
, defaultTemperatureConfig
-- * Re-exports
, TemperatureUnit(..)
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Default (Default(..))
import Data.List (intercalate)
import qualified Data.Text as T
import qualified GI.Gtk as Gtk
import qualified Text.StringTemplate as ST
import System.Taffybar.Information.Temperature
import System.Taffybar.Widget.Generic.PollingLabel (pollingLabelNewWithTooltip)
import System.Taffybar.Widget.Util (buildIconLabelBox)
-- | Configuration for the temperature widget
data TemperatureConfig = TemperatureConfig
{ tempFormat :: String
-- ^ Format string for the label. Available variables:
-- temp (in configured unit), tempC (Celsius), tempF (Fahrenheit), tempK (Kelvin)
, tempUnit :: TemperatureUnit
-- ^ Unit to use for the {temp} variable (default: Celsius)
, tempWarningThreshold :: Double
-- ^ Temperature (in Celsius) at which to show warning style (default: 70)
, tempCriticalThreshold :: Double
-- ^ Temperature (in Celsius) at which to show critical style (default: 85)
, tempPollInterval :: Double
-- ^ How often to poll for temperature updates, in seconds (default: 10)
, tempSensorFilter :: ThermalSensor -> Bool
-- ^ Filter function to select which sensors to monitor (default: all)
, tempAggregation :: [TemperatureInfo] -> Maybe Double
-- ^ How to aggregate multiple sensor readings (default: maximum)
, temperatureIcon :: T.Text
-- ^ Nerd font icon character (default U+F2C9, nf-fa-thermometer).
}
instance Default TemperatureConfig where
def = defaultTemperatureConfig
-- | Default configuration for the temperature widget
defaultTemperatureConfig :: TemperatureConfig
defaultTemperatureConfig = TemperatureConfig
{ tempFormat = "$temp$\176C" -- degree symbol
, tempUnit = Celsius
, tempWarningThreshold = 70
, tempCriticalThreshold = 85
, tempPollInterval = 10
, tempSensorFilter = const True
, tempAggregation = \temps ->
if null temps
then Nothing
else Just $ maximum $ map tempCelsius temps
, temperatureIcon = T.pack "\xF2C9"
}
-- | Create a combined icon+label temperature widget with default configuration.
temperatureNew :: MonadIO m => m Gtk.Widget
temperatureNew = temperatureNewWith defaultTemperatureConfig
-- | Create a combined icon+label temperature widget.
temperatureNewWith :: MonadIO m => TemperatureConfig -> m Gtk.Widget
temperatureNewWith config = liftIO $ do
iconWidget <- temperatureIconNewWith config
labelWidget <- temperatureLabelNewWith config
buildIconLabelBox iconWidget labelWidget
-- | Create a temperature icon widget with default configuration.
temperatureIconNew :: MonadIO m => m Gtk.Widget
temperatureIconNew = temperatureIconNewWith defaultTemperatureConfig
-- | Create a temperature icon widget with the provided configuration.
temperatureIconNewWith :: MonadIO m => TemperatureConfig -> m Gtk.Widget
temperatureIconNewWith config = liftIO $ do
label <- Gtk.labelNew (Just (temperatureIcon config))
Gtk.widgetShowAll label
Gtk.toWidget label
-- | Create a temperature label widget with default configuration.
temperatureLabelNew :: MonadIO m => m Gtk.Widget
temperatureLabelNew = temperatureLabelNewWith defaultTemperatureConfig
-- | Create a temperature label widget with custom configuration.
temperatureLabelNewWith :: MonadIO m => TemperatureConfig -> m Gtk.Widget
temperatureLabelNewWith config = liftIO $ do
-- Discover sensors once at startup, filtered by config
allSensors <- discoverSensors
let sensors = filter (tempSensorFilter config) allSensors
widget <- pollingLabelNewWithTooltip (tempPollInterval config) $ do
temps <- readTemperaturesFiltered sensors
case tempAggregation config temps of
Nothing -> return (T.pack "N/A", Nothing)
Just tempC -> do
let tempF = convertTemperature Fahrenheit tempC
tempK = convertTemperature Kelvin tempC
tempDisplay = convertTemperature (tempUnit config) tempC
labelText = formatTemperature config tempDisplay tempC tempF tempK
tooltipText = formatTooltip temps
return (labelText, Just tooltipText)
-- We need to update CSS classes dynamically, but pollingLabel doesn't
-- support that directly. Instead, we set up the widget and update classes
-- in the polling callback through a custom approach.
-- For now, we'll use a simpler approach with the base widget.
Gtk.toWidget widget
where
readTemperaturesFiltered :: [ThermalSensor] -> IO [TemperatureInfo]
readTemperaturesFiltered sensors =
filter (\t -> tempSensor t `elem` sensors) <$> readAllTemperatures
-- | Format the temperature label using the template
formatTemperature :: TemperatureConfig -> Double -> Double -> Double -> Double -> T.Text
formatTemperature config tempDisplay tempC tempF tempK =
let template = ST.newSTMP (tempFormat config)
template' = ST.setManyAttrib
[ ("temp", formatDouble tempDisplay)
, ("tempC", formatDouble tempC)
, ("tempF", formatDouble tempF)
, ("tempK", formatDouble tempK)
] template
in T.pack $ ST.render template'
where
formatDouble :: Double -> String
formatDouble d = show (round d :: Int)
-- | Format tooltip showing all sensor readings
formatTooltip :: [TemperatureInfo] -> T.Text
formatTooltip temps =
T.pack $ intercalate "\n" $ map formatSensor temps
where
formatSensor info =
sensorName (tempSensor info) ++ ": " ++
show (round (tempCelsius info) :: Int) ++ "\176C"