Bluetooth.hs

{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Widget.Bluetooth
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
--
-- This module provides a Bluetooth status widget that displays the current
-- Bluetooth state, connected devices, and optionally battery percentages.
--
-- The widget uses the 'TChan'-based system from
-- "System.Taffybar.Information.Bluetooth" for receiving updates.
-----------------------------------------------------------------------------
module System.Taffybar.Widget.Bluetooth
  ( BluetoothWidgetConfig(..)
  , defaultBluetoothWidgetConfig
  , bluetoothIconNew
  , bluetoothIconNewWith
  , bluetoothLabelNew
  , bluetoothLabelNewWith
  , bluetoothNew
  , bluetoothNewWith
  ) where

import Control.Monad (void)
import Control.Monad.IO.Class
import Data.Default (Default(..))
import Data.List (intercalate)
import qualified Data.Text as T
import qualified GI.GLib as G
import qualified GI.Gtk as Gtk
import System.Taffybar.Context (TaffyIO)
import System.Taffybar.Information.Bluetooth
import System.Taffybar.Util (postGUIASync)
import System.Taffybar.Widget.Generic.ChannelWidget
import System.Taffybar.Widget.Util (buildIconLabelBox)
import Text.StringTemplate

-- | Configuration for the Bluetooth widget.
data BluetoothWidgetConfig = BluetoothWidgetConfig
  { -- | Format string when Bluetooth is connected.
    -- Available variables: $status$, $device_alias$, $device_battery$,
    -- $num_connections$, $controller_alias$
    bluetoothFormatConnected :: String
    -- | Format string when Bluetooth is on but not connected.
  , bluetoothFormatOn :: String
    -- | Format string when Bluetooth is off (powered down).
  , bluetoothFormatOff :: String
    -- | Format string when no Bluetooth controller is found.
  , bluetoothFormatNoController :: String
    -- | Optional tooltip format.
    -- Additional variable: $device_list$
  , bluetoothTooltipFormat :: Maybe String
    -- | Format for each device in the tooltip device list.
    -- Variables: $device_alias$, $device_battery$
  , bluetoothDeviceListFormat :: String
    -- | Icon to display when Bluetooth is connected.
  , bluetoothConnectedIcon :: T.Text
    -- | Icon to display when Bluetooth is on but not connected.
  , bluetoothOnIcon :: T.Text
    -- | Icon to display when Bluetooth is off (powered down).
  , bluetoothOffIcon :: T.Text
    -- | Icon to display when no Bluetooth controller is found.
  , bluetoothNoControllerIcon :: T.Text
  }

defaultBluetoothWidgetConfig :: BluetoothWidgetConfig
defaultBluetoothWidgetConfig = BluetoothWidgetConfig
  { bluetoothFormatConnected = "$device_alias$"
  , bluetoothFormatOn = ""
  , bluetoothFormatOff = ""
  , bluetoothFormatNoController = ""
  , bluetoothTooltipFormat = Just "Bluetooth: $status$\nController: $controller_alias$\n$device_list$"
  , bluetoothDeviceListFormat = "$device_alias$ ($device_battery$%)"
  , bluetoothConnectedIcon = T.pack "\xF293"
  , bluetoothOnIcon = T.pack "\xF293"
  , bluetoothOffIcon = T.pack "\xF294"
  , bluetoothNoControllerIcon = T.pack "\xF294"
  }

instance Default BluetoothWidgetConfig where
  def = defaultBluetoothWidgetConfig

-- | Create a Bluetooth icon widget with default configuration.
bluetoothIconNew :: TaffyIO Gtk.Widget
bluetoothIconNew = bluetoothIconNewWith defaultBluetoothWidgetConfig

-- | Create a Bluetooth icon widget with custom configuration.
-- The icon updates dynamically based on the current Bluetooth status.
bluetoothIconNewWith :: BluetoothWidgetConfig -> TaffyIO Gtk.Widget
bluetoothIconNewWith config = do
  chan <- getBluetoothInfoChan
  initialInfo <- getBluetoothInfoState
  liftIO $ do
    label <- Gtk.labelNew Nothing
    let updateIcon info = postGUIASync $ do
          let iconText = case bluetoothStatus info of
                BluetoothConnected -> bluetoothConnectedIcon config
                BluetoothOn -> bluetoothOnIcon config
                BluetoothOff -> bluetoothOffIcon config
                BluetoothNoController -> bluetoothNoControllerIcon config
          Gtk.labelSetText label iconText
          updateStyleClasses label info
    void $ Gtk.onWidgetRealize label $ updateIcon initialInfo
    Gtk.widgetShowAll label
    Gtk.toWidget =<< channelWidgetNew label chan updateIcon

-- | Create a Bluetooth label widget with default configuration.
bluetoothLabelNew :: TaffyIO Gtk.Widget
bluetoothLabelNew = bluetoothLabelNewWith defaultBluetoothWidgetConfig

-- | Create a Bluetooth label widget with custom configuration.
-- The label shows text information (device alias, status, etc.) but no icon.
bluetoothLabelNewWith :: BluetoothWidgetConfig -> TaffyIO Gtk.Widget
bluetoothLabelNewWith config = do
  chan <- getBluetoothInfoChan
  initialInfo <- getBluetoothInfoState

  liftIO $ do
    label <- Gtk.labelNew Nothing

    let updateLabel info = do
          (labelText, tooltipText) <- formatBluetoothWidget config info
          postGUIASync $ do
            Gtk.labelSetMarkup label labelText
            Gtk.widgetSetTooltipMarkup label tooltipText
            -- Add CSS classes based on status
            updateStyleClasses label info

    void $ Gtk.onWidgetRealize label $ updateLabel initialInfo

    Gtk.widgetShowAll label
    Gtk.toWidget =<< channelWidgetNew label chan updateLabel

-- | Create a combined icon+label Bluetooth widget with default configuration.
bluetoothNew :: TaffyIO Gtk.Widget
bluetoothNew = bluetoothNewWith defaultBluetoothWidgetConfig

-- | Create a combined icon+label Bluetooth widget with custom configuration.
bluetoothNewWith :: BluetoothWidgetConfig -> TaffyIO Gtk.Widget
bluetoothNewWith config = do
  iconWidget <- bluetoothIconNewWith config
  labelWidget <- bluetoothLabelNewWith config
  liftIO $ buildIconLabelBox iconWidget labelWidget

-- | Update CSS classes on the widget based on Bluetooth status.
updateStyleClasses :: Gtk.Label -> BluetoothInfo -> IO ()
updateStyleClasses label info = do
  styleCtx <- Gtk.widgetGetStyleContext label

  -- Remove all bluetooth status classes first
  Gtk.styleContextRemoveClass styleCtx "bluetooth-connected"
  Gtk.styleContextRemoveClass styleCtx "bluetooth-on"
  Gtk.styleContextRemoveClass styleCtx "bluetooth-off"
  Gtk.styleContextRemoveClass styleCtx "bluetooth-no-controller"

  -- Add the appropriate class
  case bluetoothStatus info of
    BluetoothConnected -> Gtk.styleContextAddClass styleCtx "bluetooth-connected"
    BluetoothOn -> Gtk.styleContextAddClass styleCtx "bluetooth-on"
    BluetoothOff -> Gtk.styleContextAddClass styleCtx "bluetooth-off"
    BluetoothNoController -> Gtk.styleContextAddClass styleCtx "bluetooth-no-controller"

-- | Format the Bluetooth widget based on current state.
formatBluetoothWidget ::
  BluetoothWidgetConfig ->
  BluetoothInfo ->
  IO (T.Text, Maybe T.Text)
formatBluetoothWidget config info = do
  attrs <- buildAttrs info
  let format = case bluetoothStatus info of
        BluetoothConnected -> bluetoothFormatConnected config
        BluetoothOn -> bluetoothFormatOn config
        BluetoothOff -> bluetoothFormatOff config
        BluetoothNoController -> bluetoothFormatNoController config
      labelText = renderTemplate format attrs
      tooltipText = fmap (`renderTemplate` attrs) (bluetoothTooltipFormat config)
  return (T.pack labelText, T.pack <$> tooltipText)

-- | Build template attributes from Bluetooth info.
buildAttrs :: BluetoothInfo -> IO [(String, String)]
buildAttrs info = do
  let statusText = case bluetoothStatus info of
        BluetoothConnected -> "connected"
        BluetoothOn -> "on"
        BluetoothOff -> "off"
        BluetoothNoController -> "no-controller"

      -- Get the first connected device for primary display
      primaryDevice = case bluetoothConnectedDevices info of
        [] -> Nothing
        (d:_) -> Just d

      deviceAliasText = maybe "" deviceAlias primaryDevice
      deviceBatteryText = maybe "?" (maybe "?" show . deviceBatteryPercentage) primaryDevice
      numConnections = length $ bluetoothConnectedDevices info
      controllerAliasText = maybe "none" controllerAlias (bluetoothController info)

      -- Build device list for tooltip
      deviceListText = intercalate "\n" $
        map formatDeviceEntry (bluetoothConnectedDevices info)

      formatDeviceEntry dev =
        let battery = maybe "?" show (deviceBatteryPercentage dev)
        in deviceAlias dev ++ " (" ++ battery ++ "%)"

  status <- escapeText $ T.pack statusText
  deviceAliasEsc <- escapeText $ T.pack deviceAliasText
  deviceBatteryEsc <- escapeText $ T.pack deviceBatteryText
  controllerAliasEsc <- escapeText $ T.pack controllerAliasText
  deviceListEsc <- escapeText $ T.pack deviceListText

  return
    [ ("status", status)
    , ("device_alias", deviceAliasEsc)
    , ("device_battery", deviceBatteryEsc)
    , ("num_connections", show numConnections)
    , ("controller_alias", controllerAliasEsc)
    , ("device_list", deviceListEsc)
    ]

-- | Render a template with the given attributes.
renderTemplate :: String -> [(String, String)] -> String
renderTemplate template attrs = render $ setManyAttrib attrs (newSTMP template)

-- | Escape text for Pango markup.
escapeText :: T.Text -> IO String
escapeText input = T.unpack <$> G.markupEscapeText input (-1)