{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Widget.SNITray
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
-----------------------------------------------------------------------------
--
-- A widget to display the system tray.
--
-- This widget only supports the newer StatusNotifierItem (SNI) protocol;
-- older xembed applets will not be visible. AppIndicator is also a valid
-- implementation of SNI.
--
-- Additionally, it does not handle recognising new tray applets. Instead it is
-- necessary to run status-notifier-watcher from the
-- [status-notifier-item](https://github.com/taffybar/status-notifier-item)
-- package early on system startup.
-- In case this is not possiblle,
-- 'sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt is available, but
-- this may not necessarily be able to pick up everything.

module System.Taffybar.Widget.SNITray where

import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import           Data.Ratio
import qualified GI.Gtk
import           Graphics.UI.GIGtkStrut
import qualified StatusNotifier.Host.Service as H
import           StatusNotifier.Tray
import           System.Posix.Process
import           System.Taffybar.Context
import           System.Taffybar.Widget.Util
import           Text.Printf

getHost :: Bool -> TaffyIO H.Host
getHost :: Bool -> TaffyIO Host
getHost Bool
startWatcher = Taffy IO Host -> Taffy IO Host
forall t. Typeable t => Taffy IO t -> Taffy IO t
getStateDefault (Taffy IO Host -> Taffy IO Host) -> Taffy IO Host -> Taffy IO Host
forall a b. (a -> b) -> a -> b
$ do
  ProcessID
pid <- IO ProcessID -> ReaderT Context IO ProcessID
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ProcessID
getProcessID
  Client
client <- (Context -> Client) -> ReaderT Context IO Client
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Client
sessionDBusClient
  Just Host
host <- IO (Maybe Host) -> ReaderT Context IO (Maybe Host)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Host) -> ReaderT Context IO (Maybe Host))
-> IO (Maybe Host) -> ReaderT Context IO (Maybe Host)
forall a b. (a -> b) -> a -> b
$ Params -> IO (Maybe Host)
H.build Params
H.defaultParams
     { dbusClient :: Maybe Client
H.dbusClient = Client -> Maybe Client
forall a. a -> Maybe a
Just Client
client
     , uniqueIdentifier :: String
H.uniqueIdentifier = String -> String -> String
forall r. PrintfType r => String -> r
printf String
"taffybar-%s" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ProcessID -> String
forall a. Show a => a -> String
show ProcessID
pid
     , startWatcher :: Bool
H.startWatcher = Bool
startWatcher
     }
  Host -> TaffyIO Host
forall (m :: * -> *) a. Monad m => a -> m a
return Host
host

-- | Build a new StatusNotifierItem tray that will share a host with any other
-- trays that are constructed automatically
sniTrayNewFromHost :: H.Host -> TaffyIO GI.Gtk.Widget
sniTrayNewFromHost :: Host -> TaffyIO Widget
sniTrayNewFromHost Host
host = do
  Client
client <- (Context -> Client) -> ReaderT Context IO Client
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Client
sessionDBusClient
  IO Widget -> TaffyIO Widget
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Widget -> TaffyIO Widget) -> IO Widget -> TaffyIO Widget
forall a b. (a -> b) -> a -> b
$ do
    Box
tray <-
      TrayParams -> IO Box
buildTray
        TrayParams :: Host
-> Client
-> Orientation
-> TrayImageSize
-> Bool
-> StrutAlignment
-> Rational
-> TrayParams
TrayParams
        { trayHost :: Host
trayHost = Host
host
        , trayClient :: Client
trayClient = Client
client
        , trayOrientation :: Orientation
trayOrientation = Orientation
GI.Gtk.OrientationHorizontal
        , trayImageSize :: TrayImageSize
trayImageSize = TrayImageSize
Expand
        , trayIconExpand :: Bool
trayIconExpand = Bool
False
        , trayAlignment :: StrutAlignment
trayAlignment = StrutAlignment
End
        , trayOverlayScale :: Rational
trayOverlayScale = Integer
3 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
5
        }
    Box
_ <- Box -> Text -> IO Box
forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
widgetSetClassGI Box
tray Text
"sni-tray"
    Box -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
GI.Gtk.widgetShowAll Box
tray
    Box -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
GI.Gtk.toWidget Box
tray

-- | The simplest way to build a new StatusNotifierItem tray
sniTrayNew :: TaffyIO GI.Gtk.Widget
sniTrayNew :: TaffyIO Widget
sniTrayNew = Bool -> TaffyIO Host
getHost Bool
False TaffyIO Host -> (Host -> TaffyIO Widget) -> TaffyIO Widget
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Host -> TaffyIO Widget
sniTrayNewFromHost

-- | Build a new StatusNotifierItem tray that also starts its own watcher,
-- without depending on status-notifier-icon. This will not register applets
-- started before the watcher is started.
sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt :: TaffyIO GI.Gtk.Widget
sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt :: TaffyIO Widget
sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt =
  Bool -> TaffyIO Host
getHost Bool
True TaffyIO Host -> (Host -> TaffyIO Widget) -> TaffyIO Widget
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Host -> TaffyIO Widget
sniTrayNewFromHost