Systemd.hs

{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      : System.Taffybar.Widget.Systemd
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
--
-- This module provides a widget that displays the number of failed systemd
-- units. It monitors both system and user units via DBus.
--
-- The widget shows a warning indicator with the total count of failed units.
-- When there are no failures, the widget can be configured to hide.
--
-- CSS classes applied:
--
-- * @systemd-widget@ - Always applied to the container
-- * @systemd-ok@ - Applied when there are no failed units
-- * @systemd-degraded@ - Applied when there are failed units
--
-- Example CSS:
--
-- > .systemd-widget { padding: 0 5px; }
-- > .systemd-ok { color: #98c379; }
-- > .systemd-degraded { color: #e06c75; }
module System.Taffybar.Widget.Systemd
  ( SystemdConfig (..),
    defaultSystemdConfig,
    systemdIconNew,
    systemdIconNewWithConfig,
    systemdLabelNew,
    systemdLabelNewWithConfig,
    systemdNew,
    systemdNewWithConfig,
  )
where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Default (Default (..))
import qualified Data.Text as T
import GI.Gtk as Gtk
import System.Taffybar.Context
import System.Taffybar.Information.Systemd
import System.Taffybar.Util
import System.Taffybar.Widget.Generic.ChannelWidget
import System.Taffybar.Widget.Util
import Text.StringTemplate

-- | Configuration options for the systemd widget.
data SystemdConfig = SystemdConfig
  { -- | Format string when there are failed units.
    -- Available variables: $count$, $system$, $user$
    systemdFormat :: String,
    -- | Format string when there are no failures (only used if hideOnOk is False).
    systemdFormatOk :: String,
    -- | Whether to hide the widget when there are no failed units.
    systemdHideOnOk :: Bool,
    -- | Whether to monitor system units.
    systemdMonitorSystem :: Bool,
    -- | Whether to monitor user units.
    systemdMonitorUser :: Bool,
    -- | Nerd font icon character (default U+F071, warning triangle).
    systemdIcon :: T.Text
  }
  deriving (Eq, Show)

-- | Default configuration for the systemd widget.
defaultSystemdConfig :: SystemdConfig
defaultSystemdConfig =
  SystemdConfig
    { systemdFormat = "$count$",
      systemdFormatOk = "\x2713", -- Check mark
      systemdHideOnOk = True,
      systemdMonitorSystem = True,
      systemdMonitorUser = True,
      systemdIcon = T.pack "\xF071" -- Warning triangle
    }

instance Default SystemdConfig where
  def = defaultSystemdConfig

-- | Create a systemd label widget with default configuration.
systemdLabelNew :: TaffyIO Gtk.Widget
systemdLabelNew = systemdLabelNewWithConfig defaultSystemdConfig

-- | Create a systemd label widget with custom configuration.
systemdLabelNewWithConfig :: SystemdConfig -> TaffyIO Gtk.Widget
systemdLabelNewWithConfig config = do
  chan <- getSystemdInfoChan
  ctx <- ask
  liftIO $ do
    label <- labelNew Nothing
    _ <- widgetSetClassGI label "systemd-widget"

    let updateWidget info = postGUIASync $ do
          let effectiveCount = computeEffectiveCount config info
              isOk = effectiveCount == 0
          updateSystemdLabel config label info
          updateSystemdVisibility config label isOk
          updateSystemdClasses label isOk

    -- Set initial state on realize
    void $ onWidgetRealize label $ do
      info <- runReaderT getSystemdInfoState ctx
      let effectiveCount = computeEffectiveCount config info
          isOk = effectiveCount == 0
      updateSystemdLabel config label info
      updateSystemdVisibility config label isOk
      updateSystemdClasses label isOk

    toWidget =<< channelWidgetNew label chan updateWidget

-- | Create a systemd icon widget with default configuration.
systemdIconNew :: TaffyIO Gtk.Widget
systemdIconNew = systemdIconNewWithConfig defaultSystemdConfig

-- | Create a systemd icon widget with the provided configuration.
systemdIconNewWithConfig :: SystemdConfig -> TaffyIO Gtk.Widget
systemdIconNewWithConfig config = liftIO $ do
  label <- Gtk.labelNew (Just (systemdIcon config))
  Gtk.widgetShowAll label
  Gtk.toWidget label

-- | Create a combined icon+label systemd widget with default configuration.
systemdNew :: TaffyIO Gtk.Widget
systemdNew = systemdNewWithConfig defaultSystemdConfig

-- | Create a combined icon+label systemd widget with custom configuration.
systemdNewWithConfig :: SystemdConfig -> TaffyIO Gtk.Widget
systemdNewWithConfig config = do
  iconWidget <- systemdIconNewWithConfig config
  labelWidget <- systemdLabelNewWithConfig config
  liftIO $ buildIconLabelBox iconWidget labelWidget

-- | Compute the effective count based on configuration.
computeEffectiveCount :: SystemdConfig -> SystemdInfo -> Int
computeEffectiveCount config info =
  let sysCount = if systemdMonitorSystem config then systemFailedCount info else 0
      usrCount = if systemdMonitorUser config then userFailedCount info else 0
   in sysCount + usrCount

-- | Update the label text based on the current state.
updateSystemdLabel :: SystemdConfig -> Gtk.Label -> SystemdInfo -> IO ()
updateSystemdLabel config label info = do
  let effectiveCount = computeEffectiveCount config info
      isOk = effectiveCount == 0
      formatStr = if isOk then systemdFormatOk config else systemdFormat config
      tpl = newSTMP formatStr
      tpl' =
        setManyAttrib
          [ ("count", show effectiveCount),
            ("system", show (systemFailedCount info)),
            ("user", show (userFailedCount info))
          ]
          tpl
  labelSetMarkup label (render tpl')

-- | Update widget visibility based on configuration.
updateSystemdVisibility :: SystemdConfig -> Gtk.Label -> Bool -> IO ()
updateSystemdVisibility config label isOk =
  if isOk && systemdHideOnOk config
    then widgetHide label
    else widgetShow label

-- | Update CSS classes based on state.
updateSystemdClasses :: Gtk.Label -> Bool -> IO ()
updateSystemdClasses label isOk = do
  if isOk
    then do
      addClassIfMissing "systemd-ok" label
      removeClassIfPresent "systemd-degraded" label
    else do
      addClassIfMissing "systemd-degraded" label
      removeClassIfPresent "systemd-ok" label