module System.Taffybar.Widget.Generic.PollingLabel
( pollingLabelNew
, pollingLabelNewWithTooltip
) where
import Control.Concurrent
import Control.Exception.Enclosed as E
import Control.Monad
import Control.Monad.IO.Class
import System.Taffybar.Util
import qualified Data.Text as T
import GI.Gtk
import System.Taffybar.Util
import System.Taffybar.Widget.Util
pollingLabelNew
:: MonadIO m
=> T.Text
-> Double
-> IO T.Text
-> m GI.Gtk.Widget
pollingLabelNew initialString interval cmd =
pollingLabelNewWithTooltip initialString interval $ (, Nothing) <$> cmd
pollingLabelNewWithTooltip
:: MonadIO m
=> T.Text
-> Double
-> IO (T.Text, Maybe T.Text)
-> m GI.Gtk.Widget
pollingLabelNewWithTooltip initialString interval cmd =
liftIO $ do
grid <- gridNew
label <- labelNew $ Just initialString
let updateLabel (labelStr, tooltipStr) =
postGUIASync $ do
labelSetMarkup label labelStr
widgetSetTooltipMarkup label tooltipStr
_ <- onWidgetRealize label $ do
sampleThread <- foreverWithDelay interval $ E.tryAny cmd >>= either (const $ return ()) updateLabel
void $ onWidgetUnrealize label $ killThread sampleThread
vFillCenter label
vFillCenter grid
containerAdd grid label
widgetShowAll grid
toWidget grid