    {-# 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
    -----------------------------------------------------------------------------
    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 startWatcher :: Bool
    startWatcher = Taffy IO Host -> TaffyIO Host
    forall t. Typeable t => Taffy IO t -> Taffy IO t
    getStateDefault (Taffy IO Host -> TaffyIO Host) -> Taffy IO Host -> TaffyIO 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
    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 "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
    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 = 3 Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % 5
            }
        Box
    _ <- Box -> Text -> IO Box
    forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
    widgetSetClassGI Box
    tray "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

    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

    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