{-# LANGUAGE OverloadedStrings #-}
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
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
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