    {-# 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
    --
    -- This module exports functions for the construction of
    -- StatusNotifierItem/AppIndicator tray widgets, supplied by the
    -- "StatusNotifier.Tray" module from the gtk-sni-tray library. These widgets do
    -- not support the older XEMBED protocol, although bridges like
    -- xembed-sni-proxy do allow sni trays to provide limited support for XEMBED
    -- tray icons.
    --
    -- Unless 'sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt' is used it is
    -- necessary to run status-notifier-watcher from the
    -- [status-notifier-item](https://github.com/taffybar/status-notifier-item)
    -- package before starting taffybar when using the functions defined in this
    -- module. Using 'sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt' is
    -- generally not recommended, because it can lead to issues with the
    -- registration of tray icons if taffybar crashes/restarts, or if tray icon
    -- providing applications are ever started before taffybar.
    -----------------------------------------------------------------------------

    module System.Taffybar.Widget.SNITray
      ( TrayParams
      , module System.Taffybar.Widget.SNITray
      ) where

    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Reader
    import qualified GI.Gtk
    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

    -- | Build a new StatusNotifierItem tray that will share a host with any other
    -- trays that are constructed automatically
    sniTrayNew :: TaffyIO GI.Gtk.Widget
    sniTrayNew :: TaffyIO Widget
    sniTrayNew = TrayParams -> TaffyIO Widget
    sniTrayNewFromParams TrayParams
    defaultTrayParams

    -- | Build a new StatusNotifierItem tray from the provided 'TrayParams'.
    sniTrayNewFromParams :: TrayParams -> TaffyIO GI.Gtk.Widget
    sniTrayNewFromParams :: TrayParams -> TaffyIO Widget
    sniTrayNewFromParams TrayParams
    params =
      Bool -> TaffyIO Host
    getTrayHost Bool
    False TaffyIO Host -> (Host -> TaffyIO Widget) -> TaffyIO Widget
    forall a b.
    ReaderT Context IO a
    -> (a -> ReaderT Context IO b) -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= TrayParams -> Host -> TaffyIO Widget
    sniTrayNewFromHostParams TrayParams
    params

    -- | Build a new StatusNotifierItem tray from the provided 'TrayParams' and
    -- 'H.Host'.
    sniTrayNewFromHostParams :: TrayParams -> H.Host -> TaffyIO GI.Gtk.Widget
    sniTrayNewFromHostParams :: TrayParams -> Host -> TaffyIO Widget
    sniTrayNewFromHostParams TrayParams
    params 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 (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    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 <- Host -> Client -> TrayParams -> IO Box
    buildTray Host
    host Client
    client TrayParams
    params
        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

    -- | 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
    getTrayHost Bool
    True TaffyIO Host -> (Host -> TaffyIO Widget) -> TaffyIO Widget
    forall a b.
    ReaderT Context IO a
    -> (a -> ReaderT Context IO b) -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= TrayParams -> Host -> TaffyIO Widget
    sniTrayNewFromHostParams TrayParams
    defaultTrayParams

    -- | Get a 'H.Host' from 'TaffyIO' internal state, that can be used to construct
    -- SNI tray widgets. The boolean parameter determines whether or not a watcher
    -- will be started the first time 'getTrayHost' is invoked.
    getTrayHost :: Bool -> TaffyIO H.Host
    getTrayHost :: Bool -> TaffyIO Host
    getTrayHost Bool
    startWatcher = TaffyIO Host -> TaffyIO Host
    forall t. Typeable t => Taffy IO t -> Taffy IO t
    getStateDefault (TaffyIO Host -> TaffyIO Host) -> TaffyIO Host -> TaffyIO Host
    forall a b. (a -> b) -> a -> b
    $ do
      ProcessID
    pid <- IO ProcessID -> ReaderT Context IO ProcessID
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    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 (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    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 a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Host
    host