packages feed

taffybar-4.1.2: src/System/Taffybar/Widget/Privacy.hs

{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Widget.Privacy
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
--
-- Privacy indicator widget for taffybar.
--
-- Shows icons when microphone, camera, or screen sharing is active.
-- The widget is hidden when no privacy-relevant streams are active.
--
-- Example usage:
--
-- @
-- import System.Taffybar.Widget.Privacy
--
-- myConfig = defaultSimpleTaffyConfig
--   { endWidgets = [ privacyNew ]
--   }
-- @
--
-- CSS classes:
--
-- * @.privacy-widget@ - The main container
-- * @.privacy-audio-input@ - Audio input (microphone) icon
-- * @.privacy-audio-output@ - Audio output icon
-- * @.privacy-video-input@ - Video input (camera/screen share) icon
--
-----------------------------------------------------------------------------

module System.Taffybar.Widget.Privacy
  ( -- * Widget constructors
    privacyNew
  , privacyNewWith
    -- * Configuration
  , PrivacyWidgetConfig(..)
  , defaultPrivacyWidgetConfig
    -- * Re-exports
  , PrivacyConfig(..)
  , defaultPrivacyConfig
  ) where

import Control.Concurrent (forkIO)
import Control.Concurrent.STM.TChan
import Control.Monad (void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.STM (atomically)
import Data.Default (Default(..))
import Data.Int (Int32)
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import qualified GI.Gtk as Gtk
import System.Taffybar.Context (TaffyIO)
import System.Taffybar.Information.Privacy
  ( PrivacyConfig(..)
  , PrivacyInfo(..)
  , PrivacyNode(..)
  , NodeType(..)
  , defaultPrivacyConfig
  , getPrivacyInfoChan
  , getPrivacyInfoState
  )
import System.Taffybar.Util (postGUIASync)
import System.Taffybar.Widget.Util (widgetSetClassGI)

-- | Configuration for the privacy widget.
data PrivacyWidgetConfig = PrivacyWidgetConfig
  { privacyWidgetConfig :: PrivacyConfig
    -- ^ Underlying privacy monitoring configuration
  , audioInputIcon :: T.Text
    -- ^ Icon name for microphone
  , audioOutputIcon :: T.Text
    -- ^ Icon name for audio output
  , videoInputIcon :: T.Text
    -- ^ Icon name for camera/screen share
  , privacyIconSize :: Int32
    -- ^ Size of the icons (as Int32 for GTK)
  , privacySpacing :: Int
    -- ^ Spacing between icons
  } deriving (Eq, Show)

-- | Default privacy widget configuration.
defaultPrivacyWidgetConfig :: PrivacyWidgetConfig
defaultPrivacyWidgetConfig = PrivacyWidgetConfig
  { privacyWidgetConfig = defaultPrivacyConfig
  , audioInputIcon = "audio-input-microphone-symbolic"
  , audioOutputIcon = "audio-speakers-symbolic"
  , videoInputIcon = "camera-video-symbolic"
  , privacyIconSize = fromIntegral $ fromEnum Gtk.IconSizeMenu
  , privacySpacing = 4
  }

instance Default PrivacyWidgetConfig where
  def = defaultPrivacyWidgetConfig

-- | Create a privacy indicator widget with default configuration.
privacyNew :: TaffyIO Gtk.Widget
privacyNew = privacyNewWith defaultPrivacyWidgetConfig

-- | Create a privacy indicator widget with custom configuration.
privacyNewWith :: PrivacyWidgetConfig -> TaffyIO Gtk.Widget
privacyNewWith config = do
  chan <- getPrivacyInfoChan (privacyWidgetConfig config)
  initialInfo <- getPrivacyInfoState (privacyWidgetConfig config)

  liftIO $ do
    -- Create main container box
    box <- Gtk.boxNew Gtk.OrientationHorizontal (fromIntegral $ privacySpacing config)
    _ <- widgetSetClassGI box "privacy-widget"

    -- Create icons for each type (initially hidden)
    audioInImage <- createIcon (audioInputIcon config) (privacyIconSize config)
    audioOutImage <- createIcon (audioOutputIcon config) (privacyIconSize config)
    videoInImage <- createIcon (videoInputIcon config) (privacyIconSize config)

    _ <- widgetSetClassGI audioInImage "privacy-audio-input"
    _ <- widgetSetClassGI audioOutImage "privacy-audio-output"
    _ <- widgetSetClassGI videoInImage "privacy-video-input"

    -- Add icons to box
    Gtk.containerAdd box audioInImage
    Gtk.containerAdd box audioOutImage
    Gtk.containerAdd box videoInImage

    -- Create a revealer to control visibility with animation
    revealer <- Gtk.revealerNew
    Gtk.revealerSetTransitionType revealer Gtk.RevealerTransitionTypeSlideLeft
    Gtk.revealerSetTransitionDuration revealer 200
    Gtk.containerAdd revealer box

    -- Update function
    let updateWidget info = postGUIASync $ do
          let nodes = activeNodes info
              hasAudioIn = any ((== AudioInput) . nodeType) nodes
              hasAudioOut = any ((== AudioOutput) . nodeType) nodes
              hasVideoIn = any ((== VideoInput) . nodeType) nodes
              hasAny = hasAudioIn || hasAudioOut || hasVideoIn

          -- Show/hide individual icons
          Gtk.widgetSetVisible audioInImage hasAudioIn
          Gtk.widgetSetVisible audioOutImage hasAudioOut
          Gtk.widgetSetVisible videoInImage hasVideoIn

          -- Show/hide the whole widget
          Gtk.revealerSetRevealChild revealer hasAny

          -- Update tooltip
          when hasAny $ do
            let tooltipText = buildTooltip nodes
            Gtk.widgetSetTooltipText box (Just $ T.pack tooltipText)

    -- Initial update
    updateWidget initialInfo

    -- Connect to channel updates
    void $ Gtk.onWidgetRealize revealer $ do
      ourChan <- atomically $ dupTChan chan
      void $ Gtk.onWidgetUnrealize revealer $ return ()
      -- Start update thread
      let loop = do
            info <- atomically $ readTChan ourChan
            updateWidget info
            loop
      _ <- forkIO loop
      return ()

    Gtk.widgetShowAll revealer
    Gtk.toWidget revealer

-- | Create an icon image.
createIcon :: T.Text -> Int32 -> IO Gtk.Image
createIcon iconName size = do
  image <- Gtk.imageNewFromIconName (Just iconName) size
  Gtk.widgetSetVisible image False
  return image

-- | Build tooltip text from active nodes.
buildTooltip :: [PrivacyNode] -> String
buildTooltip nodes =
  let audioInNodes = filter ((== AudioInput) . nodeType) nodes
      audioOutNodes = filter ((== AudioOutput) . nodeType) nodes
      videoInNodes = filter ((== VideoInput) . nodeType) nodes

      formatSection :: String -> [PrivacyNode] -> Maybe String
      formatSection title ns
        | null ns = Nothing
        | otherwise = Just $ title ++ ":\n" ++ unlines (map formatNode ns)

      formatNode n = "  - " ++ T.unpack (appName n)

      sections = catMaybes
        [ formatSection "Microphone" audioInNodes
        , formatSection "Camera/Screen" videoInNodes
        , formatSection "Audio Output" audioOutNodes
        ]
  in intercalate "\n" sections