packages feed

taffybar-5.2.0: src/System/Taffybar/Widget/Temperature.hs

--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}

-- |
-- 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.
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 System.Taffybar.Information.Temperature
import System.Taffybar.Widget.Generic.PollingLabel (pollingLabelNewWithTooltip)
import System.Taffybar.Widget.Util (buildIconLabelBox, widgetSetClassGI)
import qualified Text.StringTemplate as ST

-- | Configuration for the temperature widget
data TemperatureConfig = TemperatureConfig
  { -- | Format string for the label. Available variables:
    -- temp (in configured unit), tempC (Celsius), tempF (Fahrenheit), tempK (Kelvin)
    tempFormat :: String,
    -- | Unit to use for the {temp} variable (default: Celsius)
    tempUnit :: TemperatureUnit,
    -- | Temperature (in Celsius) at which to show warning style (default: 70)
    tempWarningThreshold :: Double,
    -- | Temperature (in Celsius) at which to show critical style (default: 85)
    tempCriticalThreshold :: Double,
    -- | How often to poll for temperature updates, in seconds (default: 10)
    tempPollInterval :: Double,
    -- | Filter function to select which sensors to monitor (default: all)
    tempSensorFilter :: ThermalSensor -> Bool,
    -- | How to aggregate multiple sensor readings (default: maximum)
    tempAggregation :: [TemperatureInfo] -> Maybe Double,
    -- | Nerd font icon character (default U+F2C9, nf-fa-thermometer).
    temperatureIcon :: T.Text
  }

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
    >>= (`widgetSetClassGI` "temperature")

-- | 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))
  _ <- widgetSetClassGI label "temperature-icon"
  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)
  widgetSetClassGI widget "temperature-label"
  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"